Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim r As Long
With Worksheets("Card")
If Range("I25") = "" Then
r = 25
Else
r = .Range("I24").End(xlDown).Row + 1
End If
.Range("I" & r) = Me.ListBox1.Column(1)
End With
End Sub
At present the code copies the double clicked rows from I25 and so on until the last excel sheet row.
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim r As Long
Dim c As String
With Worksheets("Card")
c = "I"
If .Range(c & "25") = "" Then
r = 25
Else
r = .Range(c & "24").End(xlDown).Row + 1
If r = 34 Then
c = "K"
If .Range(c & "25") = "" Then
r = 25
Else
r = .Range(c & "24").End(xlDown).Row + 1
End If
End If
End If
.Range(c & r) = Me.ListBox1.Column(1)
End With
End Sub
Last edited by HansV on 22 Apr 2011, 11:32, edited 1 time in total.
Reason:to correct errors in code
Thanks for the help once again. How could I limit the copying of the rows to K33. At present the code keeps on copying the rows until the last row of the excel sheet?
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim r As Long
Dim c As String
With Worksheets("Card")
c = "I"
If .Range(c & "25") = "" Then
r = 25
Else
r = .Range(c & "24").End(xlDown).Row + 1
If r = 34 Then
c = "K"
If .Range(c & "25") = "" Then
r = 25
Else
r = .Range(c & "24").End(xlDown).Row + 1
If r = 34 Then
MsgBox "Sorry, you can't insert more data.", vbInformation
Exit Sub
End If
End If
End If
End If
.Range(c & r) = Me.ListBox1.Column(1)
End With
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim r As Long
Dim c As String
With Worksheets("Card")
c = "I"
r = .Range(c & .Rows.Count).End(xlUp).Row + 1
If r < 25 Then
r = 25
ElseIf r = 34 Then
c = "K"
r = .Range(c & .Rows.Count).End(xlUp).Row + 1
If r < 25 Then
r = 25
ElseIf r = 34 Then
MsgBox "Sorry, you can't insert more data.", vbInformation
Exit Sub
End If
End If
.Range(c & r) = Me.ListBox1.Column(1)
End With
End Sub
Hans I've figured out the problem. The code is not working because I have text below the I34. If I delete the texts below the code range; the code works fine.
Having this situation how could I modify the code so that it copies data to the cells even when there is text below the range specified on the code.
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim r As Long
Dim c As String
With Worksheets("Card")
c = "I"
If .Range(c & 33) <> "" Then
c = "K"
If .Range(c & 33) <> "" Then
MsgBox "Sorry, you can't insert more data.", vbInformation
Exit Sub
End If
End If
r = .Range(c & 34).End(xlUp).Row + 1
If r < 25 Then
r = 25
End If
.Range(c & r) = Me.ListBox1.Column(1)
End With
End Sub
Thanks for the help Hans. This version works fine. The errors are detected each time I run the code. For this reason the requirements are stated "tiny" by "tiny".