Full disclosure, this a continuation of a post on Chandoo
I am a noob to VBA. I had help getting this far. My file is linked below. Why is my listbox only showing one row/result? When I select a combobox value + textbox value, I'm not getting ALL of the matching results.
TEST TO SHARE_Systems Order Entry Master_v11
For example...
Open the Userform Go to the frame titled: Search Existing Orders Based on Multiple Criteria Go to the combo box, and select "Shop Order" Go to the textbox and enter "A" Click on the search button
The listbox only displays one row/result. If you clear the search, you can see there are 4 rows that match the search criteria.
Thank you in advance!
Private Sub UserForm_Initialize()
'redacted code
Sheets("Master").Activate
'***Populates the listbox and only displays 9 columns. Remaining columns are hidden by entering '0' width.***
lstMaster.ColumnWidths = "0;0;40;80;0;0;0;0;0;0;0;0;50;0;0;0;0;0;0;0;0;60;0;0;0;0;0;0;0;0;50;40;0;0;0;0;0;70;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;139;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;139;0;0;0;0;"
lstMaster.ColumnCount = 106 'Number of Columns in the ListBox
lstMaster.List = Sheets("Master").Range("A4:DB" & Sheets("Master").Cells(Rows.Count, 1).End(xlUp).Row).Value
'***Add items to combobox list. Each list item MUST match their respective column header.
cboSearchItem.AddItem "Shop Order"
cboSearchItem.AddItem "Suffix"
cboSearchItem.AddItem "Proposal"
cboSearchItem.AddItem "PO"
cboSearchItem.AddItem "SO"
cboSearchItem.AddItem "Quote"
cboSearchItem.AddItem "Transfer Order"
cboSearchItem.AddItem "Customer Name"
cboSearchItem.AddItem "End User Name"
'redacted code
End Sub
'***Search Multiple Orders Button***
Private Sub cmbSearchOrders_Click()
Dim sat, s As Long
Dim deg1, deg2 As String 'deg1 = cells(Row Index,Column Letter); 'deg2 = txtSearch.Value
'***Message popups if search value and/or search criteria are blank***
Sheets("Master").Activate
Application.ScreenUpdating = False 'Setting to 'false' speeds up the macro
If Me.txtSearch.Value = "" Then 'Condition if the textbox is blank
MsgBox "Please enter a search value.", vbOKOnly + vbExclamation, "Search" 'vbOKOnly shows only the OK button, vbExclamation shows exclamation point icon
txtSearch.SetFocus
Exit Sub
End If
If cboSearchItem.Value = "" Then ' Condition if combobox is blank
MsgBox "Please select search criteria.", vbOKOnly + vbExclamation, ""
cboSearchItem.SetFocus
Exit Sub
End If
With lstMaster
.Clear
.ColumnCount = 106
.ColumnWidths = "0;0;40;80;0;0;0;0;0;0;0;0;50;0;0;0;0;0;0;0;0;60;0;0;0;0;0;0;0;0;50;40;0;0;0;0;0;70;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;139;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;139;0;0;0;0;"
End With
'***Progress Bar***
Call Main
deg2 = txtSearch.Value
Select Case cboSearchItem.Value
Case "Shop Order"
RN = 4 'column number
Case "Suffix"
RN = 3
Case "Proposal"
RN = 13
Case "PO"
RN = 22
Case "SO"
RN = 31
Case "Quote"
RN = 32
Case "Transfer Order"
RN = 38
Case "Customer Name"
RN = 79
Case "End User Name"
RN = 102
End Select
For sat = 4 To Cells(Rows.Count, RN).End(xlUp).Row
deg1 = Cells(sat, RN)
If UCase(deg1) Like UCase(deg2) & "*" Then 'Renders txtSearch case insensitive
lstMaster.AddItem
For c = 0 To 105 'column index
lstMaster.List(s, c) = Cells(sat, c + 1) 'c+1 = column index + 1 = column number
Next c
End If
Next
Application.ScreenUpdating = True
lblProgResults = lstMaster.ListCount
End Sub
'***1 of 2 Search Results in Listbox***
Private Sub txtSearch_Change()
On Error Resume Next
lijst = [Master].Value
arg = 0
For i = 1 To UBound(lijst) 'gets the maximum length of the array lijst
If InStr(1, lijst(i, 1), txtSearch, vbTextCompare) > 0 Then
arg = arg + 1
End If
Next i
ReDim nwlijst(arg - 1, 106)
arg = 0
For i = 1 To UBound(lijst)
If InStr(1, lijst(i, 1), txtSearch, vbTextCompare) > 0 Then
For K = 1 To 106
nwlijst(arg, K - 1) = lijst(i, K)
Next K
arg = arg + 1
End If
Next
lstResults.List = nwlijst
End Sub
'***2 of 2 Search Results in Listbox***
Sub Reset()
With lstResults
.List = [Master].Value
.ListIndex = -1
End With
cmbNew.Enabled = True
cmbSave.Enabled = True
For Each ctrl In Controls
If TypeName(ctrl) = "TextBox" Or TypeName(ctrl) = "ComboBox" Or TypeName(ctrl) = "CheckBox" Then ctrl.Value = ""
Next ctrl
End Sub
I need to shorten the code, because when I added a ninth column, I reached the limit for the length of code in a single procedure. Here is the original, long code, that works, but only for eight listbox columns. I had help to shorten the code AND include a ninth column. Per my post above, I'm only getting one result/row in the listbox. Note, I this 'older' code shows 114 columns in worksheet ("MASTER"). My newer version has 106.
'***Search Button***
Private Sub cmbSearch_Click()
Dim sat, s As Long
Dim deg1, deg2 As String 'deg1 = cells(Row Index,Column Letter)and deg2 = txtSearch.Value
'redacted code
'***CODE IMPACTED BY COLUMN ADDITIONS OR DELETIONS***
With lstMaster
.Clear
.ColumnCount = 114
.ColumnWidths = "65;0;0;0;0;0;0;0;0;0;40;0;45;0;0;0;0;0;0;0;45;0;0;0;0;0;0;0;0;42;30;0;0;0;0;0;60;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;75;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;"
End With
'***Progress Bar***
Call Main
deg2 = txtSearch.Value
Select Case cboSearchItem.Value
'***Search for Shop Order Number***
Case "Shop Order"
For sat = 3 To Cells(Rows.Count, 1).End(xlUp).Row
deg1 = Cells(sat, "A") 'Row Index = 'sat', Column Index = 'A'
If UCase(deg1) Like UCase(deg2) & "*" Then 'Renders txtSearch case insensitive as long as you do not assign a case to txtSearch
lstMaster.AddItem 'Using column index which starts with '0' vs column number which starts with '1'
lstMaster.List(s, 0) = Cells(sat, "A") 'Shop Order Number
lstMaster.List(s, 1) = Cells(sat, "B") 'Email Subject Line
lstMaster.List(s, 2) = Cells(sat, "C") 'Stage
lstMaster.List(s, 3) = Cells(sat, "D") 'Stage Due
lstMaster.List(s, 4) = Cells(sat, "E") 'E10 Status
lstMaster.List(s, 5) = Cells(sat, "F") 'Start Date
lstMaster.List(s, 6) = Cells(sat, "G") 'End Date
lstMaster.List(s, 7) = Cells(sat, "H") 'Days To Process
lstMaster.List(s, 8) = Cells(sat, "I") 'Reason
lstMaster.List(s, 9) = Cells(sat, "J") 'Prefix
lstMaster.List(s, 10) = Cells(sat, "K") 'Suffix
lstMaster.List(s, 11) = Cells(sat, "L") 'Notes
lstMaster.List(s, 12) = Cells(sat, "M") 'Proposal Number
lstMaster.List(s, 13) = Cells(sat, "N") 'Salesperson
lstMaster.List(s, 14) = Cells(sat, "O") 'Proposal Date
lstMaster.List(s, 15) = Cells(sat, "P") 'Lead Time
lstMaster.List(s, 16) = Cells(sat, "Q") 'Promised Date
lstMaster.List(s, 17) = Cells(sat, "R") 'Expiration Date
lstMaster.List(s, 18) = Cells(sat, "S") 'Cost
lstMaster.List(s, 19) = Cells(sat, "T") 'Margin
lstMaster.List(s, 20) = Cells(sat, "U") 'PO
lstMaster.List(s, 21) = Cells(sat, "V") 'PO Date
lstMaster.List(s, 22) = Cells(sat, "W") 'PO Received Date
lstMaster.List(s, 23) = Cells(sat, "X") 'PO Amount
lstMaster.List(s, 24) = Cells(sat, "Y") 'PO Terms
lstMaster.List(s, 25) = Cells(sat, "Z") 'Ship Via
lstMaster.List(s, 26) = Cells(sat, "AA") 'Ship Type
lstMaster.List(s, 27) = Cells(sat, "AB") 'Ship Charges
lstMaster.List(s, 28) = Cells(sat, "AC") 'Shipping Instructions
lstMaster.List(s, 29) = Cells(sat, "AD") 'SO
lstMaster.List(s, 30) = Cells(sat, "AE") 'Quote
lstMaster.List(s, 31) = Cells(sat, "AF") 'Project Manager
lstMaster.List(s, 32) = Cells(sat, "AG") 'Short System Description
lstMaster.List(s, 33) = Cells(sat, "AH") 'Long System Description
lstMaster.List(s, 34) = Cells(sat, "AI") 'S-Code
lstMaster.List(s, 35) = Cells(sat, "AJ") 'BMTH
lstMaster.List(s, 36) = Cells(sat, "AK") 'Transfer Order Number
lstMaster.List(s, 37) = Cells(sat, "AL") 'Installation Days
lstMaster.List(s, 38) = Cells(sat, "AM") 'Start Up Days
lstMaster.List(s, 39) = Cells(sat, "AN") 'Training Days Onsite
lstMaster.List(s, 40) = Cells(sat, "AO") 'Training Days In Toledo
lstMaster.List(s, 41) = Cells(sat, "AP") 'Vendor Field Service Days
lstMaster.List(s, 42) = Cells(sat, "AQ") 'Service Technician
lstMaster.List(s, 43) = Cells(sat, "AR") 'Standard Hours 1st & 2nd Shift
lstMaster.List(s, 44) = Cells(sat, "AS") 'Standard Hours 3rd Shift
lstMaster.List(s, 45) = Cells(sat, "AT") 'Saturday, Sunday or Holidays
lstMaster.List(s, 46) = Cells(sat, "AU") 'Additional Overtime
lstMaster.List(s, 47) = Cells(sat, "AV") 'Travel Less Than 8 Hours
lstMaster.List(s, 48) = Cells(sat, "AW") 'Travel More Than 8 Hours
lstMaster.List(s, 49) = Cells(sat, "AX") 'Airfare
lstMaster.List(s, 50) = Cells(sat, "AY") 'Hotel
lstMaster.List(s, 51) = Cells(sat, "AZ") 'Car Rental
lstMaster.List(s, 52) = Cells(sat, "BA") 'Meals
lstMaster.List(s, 53) = Cells(sat, "BB") 'Mileage
lstMaster.List(s, 54) = Cells(sat, "BC") 'Parking
lstMaster.List(s, 55) = Cells(sat, "BD") 'Service Parts 1
lstMaster.List(s, 56) = Cells(sat, "BE") 'Service Parts 2
lstMaster.List(s, 57) = Cells(sat, "BF") 'Booking Fees
lstMaster.List(s, 58) = Cells(sat, "BG") 'Total
lstMaster.List(s, 59) = Cells(sat, "BH") 'Service Group
lstMaster.List(s, 60) = Cells(sat, "BI") 'Repair Technician
lstMaster.List(s, 61) = Cells(sat, "BJ") 'Repair1
lstMaster.List(s, 62) = Cells(sat, "BK") 'Amt1
lstMaster.List(s, 63) = Cells(sat, "BL") 'Repair2
lstMaster.List(s, 64) = Cells(sat, "BM") 'Amt2
lstMaster.List(s, 65) = Cells(sat, "BN") 'Repair3
lstMaster.List(s, 66) = Cells(sat, "BO") 'Amt3
lstMaster.List(s, 67) = Cells(sat, "BP") 'Repair4
lstMaster.List(s, 68) = Cells(sat, "BQ") 'Amt4
lstMaster.List(s, 69) = Cells(sat, "BR") 'Repair5
lstMaster.List(s, 70) = Cells(sat, "BS") 'Amt5
lstMaster.List(s, 71) = Cells(sat, "BT") 'Repair6
lstMaster.List(s, 72) = Cells(sat, "BU") 'Amt6
lstMaster.List(s, 73) = Cells(sat, "BV") 'Repair7
lstMaster.List(s, 74) = Cells(sat, "BW") 'Amt7
lstMaster.List(s, 75) = Cells(sat, "BX") 'Repair8
lstMaster.List(s, 76) = Cells(sat, "BY") 'Amt8
lstMaster.List(s, 77) = Cells(sat, "BZ") 'Repair Total
lstMaster.List(s, 78) = Cells(sat, "CA") 'Repair Group
lstMaster.List(s, 79) = Cells(sat, "CB") 'CustID
lstMaster.List(s, 80) = Cells(sat, "CC") 'Customer Name
lstMaster.List(s, 81) = Cells(sat, "CD") 'Bill To
lstMaster.List(s, 82) = Cells(sat, "CE") 'Address1
lstMaster.List(s, 83) = Cells(sat, "CF") 'Address2
lstMaster.List(s, 84) = Cells(sat, "CG") 'City
lstMaster.List(s, 85) = Cells(sat, "CH") 'State
lstMaster.List(s, 86) = Cells(sat, "CI") 'ZipCode
lstMaster.List(s, 87) = Cells(sat, "CJ") 'Country
lstMaster.List(s, 88) = Cells(sat, "CK") 'Diamond Distributor
lstMaster.List(s, 89) = Cells(sat, "CL") 'Tax Exempt
lstMaster.List(s, 90) = Cells(sat, "CM") 'Contact 1 Name
lstMaster.List(s, 91) = Cells(sat, "CN") 'Contact 1 Email
lstMaster.List(s, 92) = Cells(sat, "CO") 'Contact 2 Name
lstMaster.List(s, 93) = Cells(sat, "CP") 'Contact 2 Email
lstMaster.List(s, 94) = Cells(sat, "CQ") 'Ship To ID
lstMaster.List(s, 95) = Cells(sat, "CR") 'Ship To Name
lstMaster.List(s, 96) = Cells(sat, "CS") 'Ship To Address 1
lstMaster.List(s, 97) = Cells(sat, "CT") 'Ship To Address 2
lstMaster.List(s, 98) = Cells(sat, "CU") 'Ship To City
lstMaster.List(s, 99) = Cells(sat, "CV") 'Ship To State
lstMaster.List(s, 100) = Cells(sat, "CW") 'Ship To Zip Code
lstMaster.List(s, 101) = Cells(sat, "CX") 'Ship To Country
lstMaster.List(s, 102) = Cells(sat, "CY") 'End User Name
lstMaster.List(s, 103) = Cells(sat, "CZ") 'EUID
lstMaster.List(s, 104) = Cells(sat, "DA") 'Entered In E10
lstMaster.List(s, 105) = Cells(sat, "DB") 'Confirmation Of PO
lstMaster.List(s, 106) = Cells(sat, "DC") 'Request Approval (Finance)
lstMaster.List(s, 107) = Cells(sat, "DD") 'Request PM
lstMaster.List(s, 108) = Cells(sat, "DE") 'PM Assigned
lstMaster.List(s, 109) = Cells(sat, "DF") 'SO To Team/PM
lstMaster.List(s, 110) = Cells(sat, "DG") 'Approved (Finance)
lstMaster.List(s, 111) = Cells(sat, "DH") 'SOA To Customer
lstMaster.List(s, 112) = Cells(sat, "DI") 'SOA Date In E10
lstMaster.List(s, 113) = Cells(sat, "DJ") 'Request Invoice
s = s + 1
End If
Next
'redacted code for remaining Cases which each have the same number of code lines as Case "Shop Order"
End Sub
'***Search Results in Listbox 1 of 2***
Private Sub txtSearch_Change()
'redacted because it is the same code as above
End Sub
'***Search Results in Listbox 2 of 2***
Sub Reset()
'redacted because it is the same code as above
End Sub
You have lstMaster.List(s, c) = Cells(sat, c + 1) but then you don't increment s for each new record added, so it just updates the first record repeatedly.
Add a line to increment s:
For sat = 4 To Cells(Rows.Count, RN).End(xlUp).Row
deg1 = Cells(sat, RN)
If UCase(deg1) Like UCase(deg2) & "*" Then 'Renders txtSearch case insensitive
lstMaster.AddItem
For c = 0 To 105 'column index
lstMaster.List(s, c) = Cells(sat, c + 1) 'c+1 = column index + 1 = column number
Next c
s = s + 1 '<<<<<<<<<<<<<<<<
End If
Next