Copy List box contents on double click

[adam]

Hi,

How could I make the following code to copy the list box items double clicked; to cells starting from I25 to I33 and then to K25 to K33.

Code: Select all

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.

Any help on this would be kindly appreciated.

Thanks in advance.

[HansV]

Code: Select all

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

[adam]

Thanks for the help Hans. But I'm getting error message End With without with. How could this be avoided?

[sdckapr]

The error indicates that your code includes a line:
End With

WIthout having a "With ...."- type of statement

Did you mistakenly delete the line:
With Worksheets("Card")

Steve

[HansV]

Thanks for the help Hans. But I'm getting error message End With without with. How could this be avoided?

Sorry, I hit the Submit button too early, before the code was complete. I have corrected the code in my previous reply.

[adam]

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?

[HansV]

Do you want to stop at K33 or do you want to continue copying to another column?

[adam]

I want to stop at K33 and give the user a message saying that you cannot insert no more data.

[HansV]

Code: Select all

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

[adam]

Thanks for the help Hans. That worked fine and I do really appreciate that.

[adam]

The list box double click event works fine if I have text in row 24.

Suppose, I want to insert text stating from column I25 I have to put text in column I24 in order to keep inserting texts from I25 onwards to K33.

How could I make the code to insert text starting from I25 and onwards without having to write any header or that sort of text in cell I24?

Any help on this would be kindly appreciated.

Thanks in advance.

[HansV]

Try this version:

Code: Select all

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

[adam]

Thanks for the Hans. But with this modification It does not seem to copy row contents to the active sheet on list box double click.

Note: I do have data rows starting from row 3 to 23. Is this due to this reason?

[HansV]

It shouldn't matter whether there are data in rows 3-23 or not. The code will copy to the sheet named Card.

[adam]

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.

[HansV]

It's difficult if the requirements are stated tiny bit by tiny bit instead of directly at the beginning. Here is yet another version:

Code: Select all

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

[adam]

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".

Sorry for that and I do apologize for that.