combining two listbox codes as one

[kangaruz]

Hi Guys,
I have a Userform with a listbox that when an item is double clicked it will do a search of a sheet and return the value into another listbox.
I also have another code for the same listbox that will do a search of a different sheet and return the value to another list box on the same userform.
My question is, is it possible to join these two codes together so when the listbox is double clicked it will return the values into their respective listboxes?

Thanx, Mark

Code 1:
Private Sub ListBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim r As Range, ff As String, a(), n As Long, i As Integer
If Len(Me.ListBox3.Text) = 0 Then Exit Sub
With Sheets("Orders")
Set r = .Columns("f").Find(Me.ListBox3.Text, , , xlWhole)
If r Is Nothing Then
Exit Sub
End If
ff = r.Address
Do
n = n + 1
ReDim Preserve a(1 To 6, 1 To n)
For i = 1 To 6
a(i, n) = r.Offset(, i - 6).Value
Next
Set r = .Columns("f").FindNext(r)
Loop Until ff = r.Address
End With
With Me.ListBox2
.ColumnCount = 3
.ColumnWidths = "49.95 pt;55 pt;55 pt"
.Column = a
End With
Frame13.Visible = False
Frame14.Visible = True
End Sub

Code 2:
Dim r As Range, ff As String, a(), n As Long, i As Integer
If Len(Me.ListBox3.Text) = 0 Then Exit Sub
With Sheets("JobChecklist")
Set r = .Columns("b").Find(Me.ListBox3.Text, , , xlWhole)
ff = r.Address
Do
n = n + 1
ReDim Preserve a(1 To 3, 1 To n)
For i = 1 To 3
a(i, n) = r.Offset(0, -1).Value
Next
Set r = .Columns("b").FindNext(r)
Loop Until ff = r.Address
End With
With Me.ListBox4
.ColumnCount = 1
.Column = a
End With

 

[Legacy 68668]

Private Sub ListBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim r As Range, ff As String, a(), n As Long, i As Integer
If Len(Me.ListBox3.Text) = 0 Then Exit Sub
With Sheets("Orders")
    Set r = .Columns("f").Find(Me.ListBox3.Text, , , xlWhole)
    If r Is Nothing Then
        Exit Sub
    End If
    ff = r.Address
    Do
        n = n + 1
        ReDim Preserve a(1 To 6, 1 To n)
        For i = 1 To 6
            a(i, n) = r.Offset(, i - 6).Value
        Next
        Set r = .Columns("f").FindNext(r)
    Loop Until ff = r.Address
End With
With Me.ListBox2
    .ColumnCount = 3
    .ColumnWidths = "49.95 pt;55 pt;55 pt"
    .Column = a
End With
With Sheets("JobChecklist")
    Set r = .Columns("b").Find(Me.ListBox3.Text, , , xlWhole)
    If r Is Nothing Then Exit Sub
    ff = r.Address : n = 0
    Do
        n = n + 1
        ReDim Preserve a(1 To 3, 1 To n)
        For i = 1 To 3
            a(i, n) = r.Offset(0, -1).Value
        Next
        Set r = .Columns("b").FindNext(r)
    Loop Until ff = r.Address
End With
With Me.ListBox4
    .ColumnCount = 1
    .Column = a
End With
Frame13.Visible = False
Frame14.Visible = True
End Sub

 

[kangaruz]

Thanks Seiya, works great!

 

[Legacy 68668]

Correction:

With Sheets("JobChecklist")
    Set r = .Columns("b").Find(Me.ListBox3.Text, , , xlWhole)
    If r Is Nothing Then Exit Sub
    ff = r.Address : n = 0
    Do
        n = n + 1
        ReDim Preserve a(1 To 3, 1 To n)
        For i = 1 To 3
            a(i, n) = r.Offset(0, -1).Value
        Next
        Set r = .Columns("b").FindNext(r)
    Loop Until ff = r.Address
End With
With Me.ListBox4
    .ColumnCount = 1
    .Column = a
End With

Seems the following is OK

With Sheets("JobChecklist")
    Set r = .Columns("b").Find(Me.ListBox3.Text, , , xlWhole)
    If r Is Nothing Then Exit Sub
    ff = r.Address : n = 0
    Do
        n = n + 1
        ReDim Preserve a(1 To n)
        a(n) = r.Offset(0, -1).Value
        Set r = .Columns("b").FindNext(r)
    Loop Until ff = r.Address
End With
Me.ListBox4.List = a