How to populate userform listbox rowsource from search results then use one result

fonk

New Member
Joined
Mar 30, 2009
Messages
49
Hi all,
I'm trying to use the results of a userform combobox search of a second workbook in the userform list box where I can then select one choice and fetch the contents of three columns in the selected row from the second workbook to populate cells on the first workbook.
I'm stuck with trying to get the search string address into RowSource to actually see the cell contents (not the AddressStr) and list them. The results will vary in number (foundNum +1) with each search. I've tried about 20 different ideas but find myself lacking the smarts to sort this out.
Looking at the code further down, have I put the ListBox1.RowSource code in the correct place? Dare I ask what else is wrong?

Below is the line that I cannot sort. Any advice welcome.


Code:
ListBox1.RowSource = thisLoc
Part of the code (PN Search) I've used has no attributes so to the person who wrote it, thanks.

Code:
Private Sub Userform_Initialize()
With ListBox1
        .Clear ' remove existing entries from the listbox
        .ColumnCount = 3 'ListBox1.RowSource = rSource.Address(external:=True)
        ListIndex = -1
End With
    UserForm1.Show
End Sub
Code:
Private Sub CommandButton1_Click()
Dim rSource As Range
Dim oWbSource As Workbook
Dim ws As Worksheet, Found As Range, rngNm As String
Dim myText As String, FirstAddress As String, thisLoc As String
Dim AddressStr As String, foundNum As Integer
'Set Search String
Something = ComboBox1.Value
If UserForm1.ComboBox1.ListIndex <> 1 Then
'Open WB to search
Set SourceWB = Workbooks.Open("C:\Users\oc_txls47\Desktop\Crew docs\Dave Parsell\System Inventory Latest 4-1-14").Worksheets("Sheet1").Range("b5:f45")
         For Each ws In ActiveWorkbook.Worksheets
With ws
Set Found = .UsedRange.Find(What:=Something, LookIn:=xlValues, MatchCase:=False)
If Not Found Is Nothing Then
    FirstAddress = Found.Address
Do
    foundNum = foundNum + 1
        rngNm = .Name
            AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
                thisLoc = rngNm & " " & Found.Address
            Sheets(rngNm).Select
        Range(Found.Address(RowAbsolute:=False, _
ColumnAbsolute:=False)).Select
Set Found = .UsedRange.FindNext(Found)
Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If
End With
Next ws
If Len(AddressStr) Then
ListBox1.RowSource = thisLoc  
Else:
ListBox1.Value = "Unable to find " & Something & " in this workbook."
End If

Exit Sub
End If
End Sub


Cheers, Dave
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Hi all,
maybe a bit more detail may help? I've listed the steps below I want to achieve:
From TRF.xlsm Call Userform1 on Button 14 press
Type search criteia into Combobox1
Press OK, opens up Inventory.xlsx and searches
Return the search results into TRF.xlsm Userform1 Listbox1
Ability to select one result from the Listbox1 results, go back to the Inventory.xlsx and copy three columns of data from the selected row
Paste that data into TRF.xlsm cells B24, C24 & D24
Ask if another search is required
If not then close Inventory.xlsx

As mentioned in the original post I am only tripped up on listing the search results in the Listbox1 as RowSource data so I can then select the appropriate Part# or Part Description. Any assistance would be appreciated.
Dave
 
Upvote 0
Hi all,
Managed to fumble my way to a result, see code below for anyone that may be interested. My next job is to see if I can go back to the addressStr in ListBox1, column1 of the selected row and alter the stock quantity if this is the selected row. Apologies for the last post but no code tags available, that's why it's doubled up.

Code:
Private Sub CommandButton1_Click()
Dim rSource As Range
Dim oWbSource As Workbook
Dim ws As Worksheet, Found As Range, rngNm As String
Dim myText As String, firstaddress As String, thisLoc As String
Dim AddressStr As String, foundNum As Integer
 
Something = ComboBox1 '("Enter Search string")
If Something = "" Then Exit Sub
Application.ScreenUpdating = False
With ListBox1
        .Clear
        .ColumnCount = 3
        .ListIndex = -1
End With
Set SourceWB = Workbooks.Open("C:\Users\oc_txls47\Desktop\Crew docs\Dave Parsell\System Inventory Latest 4-1-14", _
        False, True)
For Each ws In ActiveWorkbook.Worksheets
    With ws
Set Found = .UsedRange.Find(What:=Something, LookIn:=xlValues, MatchCase:=False)
            If Not Found Is Nothing Then
                firstaddress = Found.Address
Do
    foundNum = foundNum + 1
        rngNm = .Name
            AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
                thisLoc = rngNm & " " & Found.Address
                    Sheets(rngNm).Select
                        Range(Found.Address(RowAbsolute:=False, _
                            ColumnAbsolute:=False)).Select

Cells(ActiveCell.Row + 0, 1).Select
Set aCell = ActiveCell
Set bCell = ActiveCell.Offset(0, 4)
Set cCell = ActiveCell.Offset(0, 5)
Set dCell = ActiveCell.Offset(0, 6)
With Me.ListBox1
Me.ListBox1.ColumnCount = 4
Me.ListBox1.ColumnWidths = "0;100;280;100"
    .AddItem
    .List(n, 0) = thisLoc
    .List(n, 1) = bCell
    .List(n, 2) = aCell
    .List(n, 3) = dCell
   
    
End With
n = n + 1
    Set Found = .UsedRange.FindNext(Found)
        Loop While Not Found Is Nothing And Found.Address <> firstaddress
            End If
                End With
                    Next ws
                        If Len(AddressStr) Then
With Me.ListBox2
    .AddItem
    .List(0, 0) = foundNum
End With
Else:
MsgBox "Unable to find " & Something & " in this workbook.", vbExclamation
End If
Exit Sub
Application.ScreenUpdating = True
End Sub


Regards, Dave
 
Upvote 0
Hi all,
Managed to fumble my way to a result, see code below for anyone that may be interested. My next job is to see if I can go back to the addressStr in ListBox1, column1 of the selected row and alter the stock quantity.

Code:
Private Sub CommandButton1_Click()
Dim rSource As Range
Dim oWbSource As Workbook
Dim ws As Worksheet, Found As Range, rngNm As String
Dim myText As String, firstaddress As String, thisLoc As String
Dim AddressStr As String, foundNum As Integer
 
Something = ComboBox1 '("Enter Search string")
If Something = "" Then Exit Sub
Application.ScreenUpdating = False
With ListBox1
        .Clear
        .ColumnCount = 3
        .ListIndex = -1
End With
Set SourceWB = Workbooks.Open("C:\Users\oc_txls47\Desktop\Crew docs\Dave Parsell\System Inventory Latest 4-1-14", _
        False, True)
For Each ws In ActiveWorkbook.Worksheets
    With ws
Set Found = .UsedRange.Find(What:=Something, LookIn:=xlValues, MatchCase:=False)
            If Not Found Is Nothing Then
                firstaddress = Found.Address
Do
    foundNum = foundNum + 1
        rngNm = .Name
            AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
                thisLoc = rngNm & " " & Found.Address
                    Sheets(rngNm).Select
                        Range(Found.Address(RowAbsolute:=False, _
                            ColumnAbsolute:=False)).Select

Cells(ActiveCell.Row + 0, 1).Select
Set aCell = ActiveCell
Set bCell = ActiveCell.Offset(0, 4)
Set cCell = ActiveCell.Offset(0, 5)
Set dCell = ActiveCell.Offset(0, 6)
With Me.ListBox1
Me.ListBox1.ColumnCount = 4
Me.ListBox1.ColumnWidths = "0;100;280;100"
    .AddItem
    .List(n, 0) = thisLoc
    .List(n, 1) = bCell
    .List(n, 2) = aCell
    .List(n, 3) = dCell
   
    
End With
n = n + 1
    Set Found = .UsedRange.FindNext(Found)
        Loop While Not Found Is Nothing And Found.Address <> firstaddress
            End If
                End With
                    Next ws
                        If Len(AddressStr) Then
With Me.ListBox2
    .AddItem
    .List(0, 0) = foundNum
End With
Else:
MsgBox "Unable to find " & Something & " in this workbook.", vbExclamation
End If
Exit Sub
Application.ScreenUpdating = True
End Sub


Regards, Dave
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top