• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA Procedure Too Large - How to break up and better manage repetitive lines of code

Hello forum!
How can I streamline the following code? The code has been working perfectly with (8) Cases, but when I added the ninth case, I got the compile error "Procedure Too Large". There is a lot of repetitive code. How can this be 'consolidated'? I only included 1 case to keep the code on the post short as possible.
Thank you in advance!


Code:
'***Search Multiple Orders Button***CODE FROM V7 FOR SEARCH STARTS HERE
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 fill-in search criteria 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

'***CODE IMPACTED BY COLUMN ADDITIONS OR DELETIONS***
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

'***Search for Shop Order Number***
'***CODE IMPACTED BY COLUMN ADDITIONS OR DELETIONS***
Case "Shop Order"
For sat = 3 To Cells(Rows.Count, 4).End(xlUp).Row  ''3' first row of data; Cells(Rows.Count,1) _
'1' column number where "Shop Order" is located; End(xlUp) selects the last filled row to direction 'up'; _
Row returns the number of the rows based on the selected cell.
deg1 = Cells(sat, "D") '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") 'PREFIX
lstMaster.List(s, 1) = Cells(sat, "B") 'E10 STATUS
lstMaster.List(s, 2) = Cells(sat, "C") 'SUFFIX
lstMaster.List(s, 3) = Cells(sat, "D") 'SHOP ORDER NUMBER
lstMaster.List(s, 4) = Cells(sat, "E") 'EMAIL SUBJECT LINE
lstMaster.List(s, 5) = Cells(sat, "F") 'NOTES
lstMaster.List(s, 6) = Cells(sat, "G") 'STAGE
lstMaster.List(s, 7) = Cells(sat, "H") 'START DATE
lstMaster.List(s, 8) = Cells(sat, "I") 'STAGE DUE
lstMaster.List(s, 9) = Cells(sat, "J") 'END DATE
lstMaster.List(s, 10) = Cells(sat, "K") 'DAYS TO PROCESS
lstMaster.List(s, 11) = Cells(sat, "L") 'REASON
lstMaster.List(s, 12) = Cells(sat, "M") 'PROPOSAL NUMBER
lstMaster.List(s, 13) = Cells(sat, "N") 'SALESPERSON
lstMaster.List(s, 14) = Cells(sat, "O") 'PRIMARY SALESPERSON TERRITORY
lstMaster.List(s, 15) = Cells(sat, "P") 'PROPOSAL DATE
lstMaster.List(s, 16) = Cells(sat, "Q") 'LEAD TIME
lstMaster.List(s, 17) = Cells(sat, "R") 'ORIGINAL PROMISE DATE
lstMaster.List(s, 18) = Cells(sat, "S") 'EXPIRATION DATE
lstMaster.List(s, 19) = Cells(sat, "T") 'COST
lstMaster.List(s, 20) = Cells(sat, "U") 'MARGIN
lstMaster.List(s, 21) = Cells(sat, "V") 'PO NUMBER
lstMaster.List(s, 22) = Cells(sat, "W") 'PO DATE
lstMaster.List(s, 23) = Cells(sat, "X") 'STEP 1 PO REC'D
lstMaster.List(s, 24) = Cells(sat, "Y") 'PO AMOUNT
lstMaster.List(s, 25) = Cells(sat, "Z") 'PO TERMS
lstMaster.List(s, 26) = Cells(sat, "AA") 'SHIP VIA
lstMaster.List(s, 27) = Cells(sat, "AB") 'SHIP TYPE
lstMaster.List(s, 28) = Cells(sat, "AC") 'SHIP CHARGES
lstMaster.List(s, 29) = Cells(sat, "AD") 'SHIPPING INSTRUCTIONS
lstMaster.List(s, 30) = Cells(sat, "AE") 'SO
lstMaster.List(s, 31) = Cells(sat, "AF") 'QUOTE
lstMaster.List(s, 32) = Cells(sat, "AG") 'PM/ME
lstMaster.List(s, 33) = Cells(sat, "AH") 'EE
lstMaster.List(s, 34) = Cells(sat, "AI") 'SYSTEM DESCRIPTION
lstMaster.List(s, 35) = Cells(sat, "AJ") 'S-CODE
lstMaster.List(s, 36) = Cells(sat, "AK") 'BMTH
lstMaster.List(s, 37) = Cells(sat, "AL") 'TRANSFER ORDER NUMBER
lstMaster.List(s, 38) = Cells(sat, "AM") 'INSTALLATION DAYS
lstMaster.List(s, 39) = Cells(sat, "AN") 'START UP DAYS
lstMaster.List(s, 40) = Cells(sat, "AO") 'TRAINING DAYS ONSITE
lstMaster.List(s, 41) = Cells(sat, "AP") 'TRAINING DAYS IN TOLEDO
lstMaster.List(s, 42) = Cells(sat, "AQ") 'VENDOR FIELD SERVICE DAYS
lstMaster.List(s, 43) = Cells(sat, "AR") 'SERVICE TECHNICIAN
lstMaster.List(s, 44) = Cells(sat, "AS") 'STANDARD HOURS 1ST & 2ND SHIFT
lstMaster.List(s, 45) = Cells(sat, "AT") 'STANDARD HOURS 3RD SHIFT
lstMaster.List(s, 46) = Cells(sat, "AU") 'SATURDAY, SUNDAY OR HOLIDAYS
lstMaster.List(s, 47) = Cells(sat, "AV") 'ADDITIONAL OVERTIME
lstMaster.List(s, 48) = Cells(sat, "AW") 'TRAVEL LESS THAN 8 HOURS
lstMaster.List(s, 49) = Cells(sat, "AX") 'TRAVEL MORE THAN 8 HOURS
lstMaster.List(s, 50) = Cells(sat, "AY") 'AIRFARE
lstMaster.List(s, 51) = Cells(sat, "AZ") 'HOTEL
lstMaster.List(s, 52) = Cells(sat, "BA") 'CAR RENTAL
lstMaster.List(s, 53) = Cells(sat, "BB") 'MEALS
lstMaster.List(s, 54) = Cells(sat, "BC") 'MILEAGE
lstMaster.List(s, 55) = Cells(sat, "BD") 'PARKING
lstMaster.List(s, 56) = Cells(sat, "BE") 'SERVICE PARTS 1
lstMaster.List(s, 57) = Cells(sat, "BF") 'SERVICE PARTS 2
lstMaster.List(s, 58) = Cells(sat, "BG") 'BOOKING FEES
lstMaster.List(s, 59) = Cells(sat, "BH") 'SUMMARY
lstMaster.List(s, 60) = Cells(sat, "BI") 'TOTAL
lstMaster.List(s, 61) = Cells(sat, "BJ") 'SERVICE GROUP
lstMaster.List(s, 62) = Cells(sat, "BK") 'STEP2 REQUEST QUOTE APPROVAL
lstMaster.List(s, 63) = Cells(sat, "BL") 'STEP 3 QUOTE APPROVED
lstMaster.List(s, 64) = Cells(sat, "BM") 'STEP 4 CONFIRM PO REC'D
lstMaster.List(s, 65) = Cells(sat, "BN") 'STEP 5 E10
lstMaster.List(s, 66) = Cells(sat, "BO") 'STEP 6 REQUEST APPROVAL
lstMaster.List(s, 67) = Cells(sat, "BP") 'STEP 7 REQUEST PM
lstMaster.List(s, 68) = Cells(sat, "BQ") 'STEP 8 PM ASSIGNED
lstMaster.List(s, 69) = Cells(sat, "BR") 'STEP 9 SO TO TEAM
lstMaster.List(s, 70) = Cells(sat, "BS") 'STEP 10 APPROVED
lstMaster.List(s, 71) = Cells(sat, "BT") 'STEP 11 SOA TO CUSTOMER
lstMaster.List(s, 72) = Cells(sat, "BU") 'STEP 12 SOA DATE IN E10
lstMaster.List(s, 73) = Cells(sat, "BV") 'STEP 13 REQUEST 1ST DEPOSIT INVOICE
lstMaster.List(s, 74) = Cells(sat, "BW") 'CURRENT PROMISE DATE
lstMaster.List(s, 75) = Cells(sat, "BX") 'RECOGNIZE REVENUE DATE
lstMaster.List(s, 76) = Cells(sat, "BY") 'SHIPMENT NOTES
lstMaster.List(s, 77) = Cells(sat, "BZ") 'SHIPPED DATE
lstMaster.List(s, 78) = Cells(sat, "CA") 'CUSTOMER NAME
lstMaster.List(s, 79) = Cells(sat, "CB") 'DIAMOND DISTRIBUTOR
lstMaster.List(s, 80) = Cells(sat, "CC") 'CUSTID
lstMaster.List(s, 81) = Cells(sat, "CD") 'Alt Bill-To
lstMaster.List(s, 82) = Cells(sat, "CE") 'BILL-TO ADDRESS1
lstMaster.List(s, 83) = Cells(sat, "CF") 'BILL-TO ADDRESS2
lstMaster.List(s, 84) = Cells(sat, "CG") 'BILL-TO CITY
lstMaster.List(s, 85) = Cells(sat, "CH") 'BILL-TO STATE
lstMaster.List(s, 86) = Cells(sat, "CI") 'BILL-TO ZIP CODE
lstMaster.List(s, 87) = Cells(sat, "CJ") 'BILL-TO COUNTRY
lstMaster.List(s, 88) = Cells(sat, "CK") 'TAX EXEMPT
lstMaster.List(s, 89) = Cells(sat, "CL") 'CONTACT 1 NAME
lstMaster.List(s, 90) = Cells(sat, "CM") 'CONTACT 1 EMAIL
lstMaster.List(s, 91) = Cells(sat, "CN") 'CONTACT 2 NAME
lstMaster.List(s, 92) = Cells(sat, "CO") 'CONTACT 2 EMAIL
lstMaster.List(s, 93) = Cells(sat, "CP") 'SHIP-TO ID
lstMaster.List(s, 94) = Cells(sat, "CQ") 'SHIP-TO NAME
lstMaster.List(s, 95) = Cells(sat, "CR") 'SHIP-TO ADDRESS 1
lstMaster.List(s, 96) = Cells(sat, "CS") 'SHIP-TO ADDRESS 2
lstMaster.List(s, 97) = Cells(sat, "CT") 'SHIP-TO CITY
lstMaster.List(s, 98) = Cells(sat, "CU") 'SHIP-TO STATE
lstMaster.List(s, 99) = Cells(sat, "CV") 'SHIP-TO ZIP CODE
lstMaster.List(s, 100) = Cells(sat, "CW") 'SHIP-TO COUNTRY
lstMaster.List(s, 101) = Cells(sat, "CX") 'END USER NAME
lstMaster.List(s, 102) = Cells(sat, "CY") 'EUID
lstMaster.List(s, 103) = Cells(sat, "CZ") 'TIMESTAMP
lstMaster.List(s, 104) = Cells(sat, "DA") 'CURRENT PROMISE DATE
lstMaster.List(s, 105) = Cells(sat, "DB") 'CURRENT PROMISE MONTH

s = s + 1
End If
Next

'redacted Case "Suffix", Case "Proposal", Case "PO", Case "SO", Case "Quote", Case "Transfer Order", Case "Customer Name", Case "End User Name"

End Select
Application.ScreenUpdating = True
lblProgResults = lstMaster.ListCount
End Sub
 
That code can't work. If you use .AddItem to populate a listbox, you are limited to 10 columns.
 

Yodelayheewho

You wrote something (after my posting) about nine.
... Your code shows
Code:
With lstMaster
    .Clear
    .ColumnCount = 106
' I skipped Your next line.
'    .ColumnWidths = "..."
End With

' You could test something like below to get shorter code instead Your code.
For sat ...
' Your code...
    if ....
' Your code...
        For c = 0 to 105
            lstMaster.List(s, c) = Cells(s, c+1)
        Next c
    EndIf
Next
 

Yodelayheewho

Other sample based Your deleted reply.
You wrote something (after my posting) about nine.
( and as written in #2 reply ... max ten columns )
Your original code 'loads' all columns to lstMaster
>>> You could load only those columns which 'Your widths are over zero' ... someway like below.
Note #1. I didn't test below code at all (including - are those expected column) ... as well as I cleared some Your lines away
Note #2: If You'll paste some data back to sheet then You should take care that too.

Code:
'***CODE IMPACTED BY COLUMN ADDITIONS OR DELETIONS***
    With lstMaster
        .Clear
        .ColumnCount = 9
        .ColumnWidths = "40;80;50;60;50;40;70;139;139;"
    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, 4).End(xlUp).Row
                deg1 = Cells(sat, "D") 'Row Index = 'sat', Column Index = 'A'
                If UCase(deg1) Like UCase(deg2) & "*" Then
                    lstMaster.AddItem
                    lstMaster.List(s, 0) = Cells(sat, "C") 'SUFFIX
                    lstMaster.List(s, 1) = Cells(sat, "D") 'SHOP ORDER NUMBER
                    lstMaster.List(s, 2) = Cells(sat, "M") 'PROPOSAL NUMBER
                    lstMaster.List(s, 3) = Cells(sat, "V") 'PO NUMBER
                    lstMaster.List(s, 4) = Cells(sat, "AD") 'SHIPPING INSTRUCTIONS
                    lstMaster.List(s, 5) = Cells(sat, "AK") 'BMTH
                    lstMaster.List(s, 6) = Cells(sat, "AL") 'TRANSFER ORDER NUMBER
                    lstMaster.List(s, 7) = Cells(sat, "AZ") 'HOTEL
                    lstMaster.List(s, 8) = Cells(sat, "CW") 'SHIP-TO COUNTRY
                    s = s + 1
                End If
            Next
    End Select
 
OMG!!! This is terrific.
I ran into a Compile error: Case with Select Case. To fix this, I added: Select Case cboSearchItem. Value before each Case and the error disappeared.
Thank you vletm, you really made my day!


Code:
'***CODE IMPACTED BY COLUMN ADDITIONS OR DELETIONS***
With lstMaster
        .Clear
        .ColumnCount = 9
        .ColumnWidths = "40;80;50;60;50;40;70;139;139;"
End With

'***Progress Bar***
Call Main
deg2 = txtSearch.Value

'***Search for Shop Order Number***
Select Case cboSearchItem.Value
    Case "Shop Order"
            For sat = 3 To Cells(Rows.Count, 4).End(xlUp).Row
                deg1 = Cells(sat, "D") 'Set deg1? 'Row Index = 'sat', Column Index = 'D'
                If UCase(deg1) Like UCase(deg2) & "*" Then 'Renders txtSearch case insensitive as long as you do not assign a case to txtSearch
                        lstMaster.AddItem
                        lstMaster.List(s, 0) = Cells(sat, "C") 'SUFFIX
                        lstMaster.List(s, 1) = Cells(sat, "D") 'SHOP ORDER NUMBER
                        lstMaster.List(s, 2) = Cells(sat, "M") 'PROPOSAL NUMBER
                        lstMaster.List(s, 3) = Cells(sat, "V") 'PO NUMBER
                        lstMaster.List(s, 4) = Cells(sat, "AE") 'SO
                        lstMaster.List(s, 5) = Cells(sat, "AF") 'QUOTE
                        lstMaster.List(s, 6) = Cells(sat, "AL") 'TRANSFER ORDER NUMBER
                        lstMaster.List(s, 7) = Cells(sat, "CA") 'CUSTOMER NAME
                        lstMaster.List(s, 8) = Cells(sat, "CX") 'END USER NAME
                        s = s + 1
                End If
        Next
End Select

'***Search Suffix***
Select Case cboSearchItem.Value
    Case "Suffix"
            For sat = 3 To Cells(Rows.Count, 3).End(xlUp).Row '3 = row number where data starts, 9 = column number for Suffix
                deg1 = Cells(sat, "C")
                If UCase(deg1) Like UCase(deg2) & "*" Then
                        lstMaster.AddItem
                        lstMaster.List(s, 0) = Cells(sat, "C") 'SUFFIX
                        lstMaster.List(s, 1) = Cells(sat, "D") 'SHOP ORDER NUMBER
                        lstMaster.List(s, 2) = Cells(sat, "M") 'PROPOSAL NUMBER
                        lstMaster.List(s, 3) = Cells(sat, "V") 'PO NUMBER
                        lstMaster.List(s, 4) = Cells(sat, "AE") 'SO
                        lstMaster.List(s, 5) = Cells(sat, "AF") 'QUOTE
                        lstMaster.List(s, 6) = Cells(sat, "AL") 'TRANSFER ORDER NUMBER
                        lstMaster.List(s, 7) = Cells(sat, "CA") 'CUSTOMER NAME
                        lstMaster.List(s, 8) = Cells(sat, "CX") 'END USER NAME
                        s = s + 1
                End If
        Next
End Select

'***Search for Proposal***
Select Case cboSearchItem.Value
    Case "Proposal"
            For sat = 3 To Cells(Rows.Count, 13).End(xlUp).Row '3 = row number where data starts, 11 = column number for Proposal
                deg1 = Cells(sat, "M")
                If UCase(deg1) Like UCase(deg2) & "*" Then
                        lstMaster.AddItem
                        lstMaster.List(s, 0) = Cells(sat, "C") 'SUFFIX
                        lstMaster.List(s, 1) = Cells(sat, "D") 'SHOP ORDER NUMBER
                        lstMaster.List(s, 2) = Cells(sat, "M") 'PROPOSAL NUMBER
                        lstMaster.List(s, 3) = Cells(sat, "V") 'PO NUMBER
                        lstMaster.List(s, 4) = Cells(sat, "AE") 'SO
                        lstMaster.List(s, 5) = Cells(sat, "AF") 'QUOTE
                        lstMaster.List(s, 6) = Cells(sat, "AL") 'TRANSFER ORDER NUMBER
                        lstMaster.List(s, 7) = Cells(sat, "CA") 'CUSTOMER NAME
                        lstMaster.List(s, 8) = Cells(sat, "CX") 'END USER NAME
                        s = s + 1
                End If
        Next
End Select

'***Search for PO***'
Select Case cboSearchItem.Value
    Case "PO"
            For sat = 3 To Cells(Rows.Count, 22).End(xlUp).Row '3 = row number where data starts, 19 = column number for PO
            deg1 = Cells(sat, "V")
            If UCase(deg1) Like UCase(deg2) & "*" Then
                        lstMaster.AddItem
                        lstMaster.List(s, 0) = Cells(sat, "C") 'SUFFIX
                        lstMaster.List(s, 1) = Cells(sat, "D") 'SHOP ORDER NUMBER
                        lstMaster.List(s, 2) = Cells(sat, "M") 'PROPOSAL NUMBER
                        lstMaster.List(s, 3) = Cells(sat, "V") 'PO NUMBER
                        lstMaster.List(s, 4) = Cells(sat, "AE") 'SO
                        lstMaster.List(s, 5) = Cells(sat, "AF") 'QUOTE
                        lstMaster.List(s, 6) = Cells(sat, "AL") 'TRANSFER ORDER NUMBER
                        lstMaster.List(s, 7) = Cells(sat, "CA") 'CUSTOMER NAME
                        lstMaster.List(s, 8) = Cells(sat, "CX") 'END USER NAME
                        s = s + 1
                End If
        Next
End Select

'***Search for SO***
Select Case cboSearchItem.Value
    Case "SO"
        For sat = 3 To Cells(Rows.Count, 31).End(xlUp).Row '3 = row number where data starts, 28 = column number for SO
        deg1 = Cells(sat, "AE")
        If UCase(deg1) Like UCase(deg2) & "*" Then
                        lstMaster.AddItem
                        lstMaster.List(s, 0) = Cells(sat, "C") 'SUFFIX
                        lstMaster.List(s, 1) = Cells(sat, "D") 'SHOP ORDER NUMBER
                        lstMaster.List(s, 2) = Cells(sat, "M") 'PROPOSAL NUMBER
                        lstMaster.List(s, 3) = Cells(sat, "V") 'PO NUMBER
                        lstMaster.List(s, 4) = Cells(sat, "AE") 'SO
                        lstMaster.List(s, 5) = Cells(sat, "AF") 'QUOTE
                        lstMaster.List(s, 6) = Cells(sat, "AL") 'TRANSFER ORDER NUMBER
                        lstMaster.List(s, 7) = Cells(sat, "CA") 'CUSTOMER NAME
                        lstMaster.List(s, 8) = Cells(sat, "CX") 'END USER NAME
                        s = s + 1
                End If
        Next
End Select

redacted code here...
Application.ScreenUpdating = True
lblProgResults = lstMaster.ListCount
End Sub
 

Yodelayheewho

Why do You have five times same lines of code?
Code:
                        lstMaster.AddItem
                        lstMaster.List(s, 0) = Cells(sat, "C") 'SUFFIX
                        lstMaster.List(s, 1) = Cells(sat, "D") 'SHOP ORDER NUMBER
                        lstMaster.List(s, 2) = Cells(sat, "M") 'PROPOSAL NUMBER
                        lstMaster.List(s, 3) = Cells(sat, "V") 'PO NUMBER
                        lstMaster.List(s, 4) = Cells(sat, "AE") 'SO
                        lstMaster.List(s, 5) = Cells(sat, "AF") 'QUOTE
                        lstMaster.List(s, 6) = Cells(sat, "AL") 'TRANSFER ORDER NUMBER
                        lstMaster.List(s, 7) = Cells(sat, "CA") 'CUSTOMER NAME
                        lstMaster.List(s, 8) = Cells(sat, "CX") 'END USER NAME
                        s = s + 1
... hmm? Actually almost all those cases are same.
You could solve/use in those only differences and after that You'll get less duplicated lines.
 
I celebrated a little too soon. My sample file is too large to upload. So, I'm including images.
Image Example 1: I do not use the Search combo box & Search criteria, so cmbSearchOrders_Click() event does not run. Instead, I just click on an order in the listbox and the textboxes, etc. populate as expected.
Image Example 2: Here I select "Shop Order" and "ASO" as my search criteria which runs the cmbSearchOrders_Click() code. However, I'm not getting the same results. It seems that leaving the '0' columns out of the lstMaster.AddItem listing is the problem, which means I'm back where I started. Right?
 

Attachments

  • Example 1.jpg
    Example 1.jpg
    528.7 KB · Views: 4
  • Example 2.jpg
    Example 2.jpg
    432.1 KB · Views: 4

Yodelayheewho

One reason about Your the latest ... wondering ... is Copy & Paste.
You've copied and pasted those Select ... End Selects as below
It works ... as You've coded ... but it won't work as You would like it to work.
Code:
Select Case cboSearchItem.Value
    Case "Shop Order"
'       Your loop
End Select

'***Search Suffix***
Select Case cboSearchItem.Value
    Case "Suffix"
'       Your loop
End Select

'***Search for Proposal***
Select Case cboSearchItem.Value
    Case "Proposal"
'       Your loop code
End Select

'***Search for PO***'
Select Case cboSearchItem.Value
    Case "PO"
'       Your loop code
End Select

'***Search for SO***
Select Case cboSearchItem.Value
    Case "SO"
'       Your loop code
End Select

Based Your #6 reply ...
You could test something like below
Code:
'***CODE IMPACTED BY COLUMN ADDITIONS OR DELETIONS***
    With lstMaster
        .Clear
        .ColumnCount = 9
        .ColumnWidths = "40;80;50;60;50;40;70;139;139;"
    End With

'***Progress Bar***
    Call Main
    deg2 = txtSearch.Value

    Select Case cboSearchItem.Value
        Case "Shop Order"
            RN = 4
        Case "Suffix"
            RN = 3
        Case "Proposal"
            RN = 13
        Case "PO"
            RN = 22
        Case "SO"
            RN = 31
    End Select

    For sat = 3 To Cells(Rows.Count, RN).End(xlUp).Row
        deg1 = Cells(sat, RN)
        If UCase(deg1) Like UCase(deg2) & "*" Then
            lstMaster.AddItem
            lstMaster.List(s, 0) = Cells(sat, "C") 'SUFFIX
            lstMaster.List(s, 1) = Cells(sat, "D") 'SHOP ORDER NUMBER
            lstMaster.List(s, 2) = Cells(sat, "M") 'PROPOSAL NUMBER
            lstMaster.List(s, 3) = Cells(sat, "V") 'PO NUMBER
            lstMaster.List(s, 4) = Cells(sat, "AE") 'SO
            lstMaster.List(s, 5) = Cells(sat, "AF") 'QUOTE
            lstMaster.List(s, 6) = Cells(sat, "AL") 'TRANSFER ORDER NUMBER
            lstMaster.List(s, 7) = Cells(sat, "CA") 'CUSTOMER NAME
            lstMaster.List(s, 8) = Cells(sat, "CX") 'END USER NAME
            s = s + 1
        End If
    Next

'redacted code here...
Application.ScreenUpdating = True
lblProgResults = lstMaster.ListCount
Of course, I could not test above at all.
 
Great news. I think we've got it! The final code is below. I also included a screenshot: (1) Search "Transfer Order" (2) that starts with "t". The results show two orders in the listbox. (3) When I click on the first order in the listbox, (4) all of the data for that row populates the textboxes within the multipage control. This has solved the issue completely. I also read the article you suggested in post #3 and saved it for future reference. Thank you again vletm!!!

Code:
'***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
    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  '4 = first row of data NOT including column headers
    deg1 = Cells(sat, RN) 'Row Index = 'sat', RN is the Column Index? Number?
    If UCase(deg1) Like UCase(deg2) & "*" Then 'Renders txtSearch case insensitive
        lstMaster.AddItem
        lstMaster.List(s, 0) = Cells(sat, "A") 'PREFIX
        lstMaster.List(s, 1) = Cells(sat, "B") 'E10 STATUS
        lstMaster.List(s, 2) = Cells(sat, "C") 'SUFFIX
        lstMaster.List(s, 3) = Cells(sat, "D") 'SHOP ORDER NUMBER
        lstMaster.List(s, 4) = Cells(sat, "E") 'EMAIL SUBJECT LINE
        lstMaster.List(s, 5) = Cells(sat, "F") 'NOTES
        lstMaster.List(s, 6) = Cells(sat, "G") 'STAGE
        lstMaster.List(s, 7) = Cells(sat, "H") 'START DATE
        lstMaster.List(s, 8) = Cells(sat, "I") 'STAGE DUE
        lstMaster.List(s, 9) = Cells(sat, "J") 'END DATE
        lstMaster.List(s, 10) = Cells(sat, "K") 'DAYS TO PROCESS
        lstMaster.List(s, 11) = Cells(sat, "L") 'REASON
        lstMaster.List(s, 12) = Cells(sat, "M") 'PROPOSAL NUMBER
        lstMaster.List(s, 13) = Cells(sat, "N") 'SALESPERSON
        lstMaster.List(s, 14) = Cells(sat, "O") 'PRIMARY SALESPERSON TERRITORY
        lstMaster.List(s, 15) = Cells(sat, "P") 'PROPOSAL DATE
        lstMaster.List(s, 16) = Cells(sat, "Q") 'LEAD TIME
        lstMaster.List(s, 17) = Cells(sat, "R") 'ORIGINAL PROMISE DATE
        lstMaster.List(s, 18) = Cells(sat, "S") 'EXPIRATION DATE
        lstMaster.List(s, 19) = Cells(sat, "T") 'COST
        lstMaster.List(s, 20) = Cells(sat, "U") 'MARGIN
        lstMaster.List(s, 21) = Cells(sat, "V") 'PO NUMBER
        lstMaster.List(s, 22) = Cells(sat, "W") 'PO DATE
        lstMaster.List(s, 23) = Cells(sat, "X") 'STEP 1 PO REC'D
        lstMaster.List(s, 24) = Cells(sat, "Y") 'PO AMOUNT
        lstMaster.List(s, 25) = Cells(sat, "Z") 'PO TERMS
        lstMaster.List(s, 26) = Cells(sat, "AA") 'SHIP VIA
        lstMaster.List(s, 27) = Cells(sat, "AB") 'SHIP TYPE
        lstMaster.List(s, 28) = Cells(sat, "AC") 'SHIP CHARGES
        lstMaster.List(s, 29) = Cells(sat, "AD") 'SHIPPING INSTRUCTIONS
        lstMaster.List(s, 30) = Cells(sat, "AE") 'SO
        lstMaster.List(s, 31) = Cells(sat, "AF") 'QUOTE
        lstMaster.List(s, 32) = Cells(sat, "AG") 'PM/ME
        lstMaster.List(s, 33) = Cells(sat, "AH") 'EE
        lstMaster.List(s, 34) = Cells(sat, "AI") 'SYSTEM DESCRIPTION
        lstMaster.List(s, 35) = Cells(sat, "AJ") 'S-CODE
        lstMaster.List(s, 36) = Cells(sat, "AK") 'BMTH
        lstMaster.List(s, 37) = Cells(sat, "AL") 'TRANSFER ORDER NUMBER
        lstMaster.List(s, 38) = Cells(sat, "AM") 'INSTALLATION DAYS
        lstMaster.List(s, 39) = Cells(sat, "AN") 'START UP DAYS
        lstMaster.List(s, 40) = Cells(sat, "AO") 'TRAINING DAYS ONSITE
        lstMaster.List(s, 41) = Cells(sat, "AP") 'TRAINING DAYS IN TOLEDO
        lstMaster.List(s, 42) = Cells(sat, "AQ") 'VENDOR FIELD SERVICE DAYS
        lstMaster.List(s, 43) = Cells(sat, "AR") 'SERVICE TECHNICIAN
        lstMaster.List(s, 44) = Cells(sat, "AS") 'STANDARD HOURS 1ST & 2ND SHIFT
        lstMaster.List(s, 45) = Cells(sat, "AT") 'STANDARD HOURS 3RD SHIFT
        lstMaster.List(s, 46) = Cells(sat, "AU") 'SATURDAY, SUNDAY OR HOLIDAYS
        lstMaster.List(s, 47) = Cells(sat, "AV") 'ADDITIONAL OVERTIME
        lstMaster.List(s, 48) = Cells(sat, "AW") 'TRAVEL LESS THAN 8 HOURS
        lstMaster.List(s, 49) = Cells(sat, "AX") 'TRAVEL MORE THAN 8 HOURS
        lstMaster.List(s, 50) = Cells(sat, "AY") 'AIRFARE
        lstMaster.List(s, 51) = Cells(sat, "AZ") 'HOTEL
        lstMaster.List(s, 52) = Cells(sat, "BA") 'CAR RENTAL
        lstMaster.List(s, 53) = Cells(sat, "BB") 'MEALS
        lstMaster.List(s, 54) = Cells(sat, "BC") 'MILEAGE
        lstMaster.List(s, 55) = Cells(sat, "BD") 'PARKING
        lstMaster.List(s, 56) = Cells(sat, "BE") 'SERVICE PARTS 1
        lstMaster.List(s, 57) = Cells(sat, "BF") 'SERVICE PARTS 2
        lstMaster.List(s, 58) = Cells(sat, "BG") 'BOOKING FEES
        lstMaster.List(s, 59) = Cells(sat, "BH") 'SUMMARY
        lstMaster.List(s, 60) = Cells(sat, "BI") 'TOTAL
        lstMaster.List(s, 61) = Cells(sat, "BJ") 'SERVICE GROUP
        lstMaster.List(s, 62) = Cells(sat, "BK") 'STEP2 REQUEST QUOTE APPROVAL
        lstMaster.List(s, 63) = Cells(sat, "BL") 'STEP 3 QUOTE APPROVED
        lstMaster.List(s, 64) = Cells(sat, "BM") 'STEP 4 CONFIRM PO REC'D
        lstMaster.List(s, 65) = Cells(sat, "BN") 'STEP 5 E10
        lstMaster.List(s, 66) = Cells(sat, "BO") 'STEP 6 REQUEST APPROVAL
        lstMaster.List(s, 67) = Cells(sat, "BP") 'STEP 7 REQUEST PM
        lstMaster.List(s, 68) = Cells(sat, "BQ") 'STEP 8 PM ASSIGNED
        lstMaster.List(s, 69) = Cells(sat, "BR") 'STEP 9 SO TO TEAM
        lstMaster.List(s, 70) = Cells(sat, "BS") 'STEP 10 APPROVED
        lstMaster.List(s, 71) = Cells(sat, "BT") 'STEP 11 SOA TO CUSTOMER
        lstMaster.List(s, 72) = Cells(sat, "BU") 'STEP 12 SOA DATE IN E10
        lstMaster.List(s, 73) = Cells(sat, "BV") 'STEP 13 REQUEST 1ST DEPOSIT INVOICE
        lstMaster.List(s, 74) = Cells(sat, "BW") 'CURRENT PROMISE DATE
        lstMaster.List(s, 75) = Cells(sat, "BX") 'RECOGNIZE REVENUE DATE
        lstMaster.List(s, 76) = Cells(sat, "BY") 'SHIPMENT NOTES
        lstMaster.List(s, 77) = Cells(sat, "BZ") 'SHIPPED DATE
        lstMaster.List(s, 78) = Cells(sat, "CA") 'CUSTOMER NAME
        lstMaster.List(s, 79) = Cells(sat, "CB") 'DIAMOND DISTRIBUTOR
        lstMaster.List(s, 80) = Cells(sat, "CC") 'CUSTID
        lstMaster.List(s, 81) = Cells(sat, "CD") 'Alt Bill-To
        lstMaster.List(s, 82) = Cells(sat, "CE") 'BILL-TO ADDRESS1
        lstMaster.List(s, 83) = Cells(sat, "CF") 'BILL-TO ADDRESS2
        lstMaster.List(s, 84) = Cells(sat, "CG") 'BILL-TO CITY
        lstMaster.List(s, 85) = Cells(sat, "CH") 'BILL-TO STATE
        lstMaster.List(s, 86) = Cells(sat, "CI") 'BILL-TO ZIP CODE
        lstMaster.List(s, 87) = Cells(sat, "CJ") 'BILL-TO COUNTRY
        lstMaster.List(s, 88) = Cells(sat, "CK") 'TAX EXEMPT
        lstMaster.List(s, 89) = Cells(sat, "CL") 'CONTACT 1 NAME
        lstMaster.List(s, 90) = Cells(sat, "CM") 'CONTACT 1 EMAIL
        lstMaster.List(s, 91) = Cells(sat, "CN") 'CONTACT 2 NAME
        lstMaster.List(s, 92) = Cells(sat, "CO") 'CONTACT 2 EMAIL
        lstMaster.List(s, 93) = Cells(sat, "CP") 'SHIP-TO ID
        lstMaster.List(s, 94) = Cells(sat, "CQ") 'SHIP-TO NAME
        lstMaster.List(s, 95) = Cells(sat, "CR") 'SHIP-TO ADDRESS 1
        lstMaster.List(s, 96) = Cells(sat, "CS") 'SHIP-TO ADDRESS 2
        lstMaster.List(s, 97) = Cells(sat, "CT") 'SHIP-TO CITY
        lstMaster.List(s, 98) = Cells(sat, "CU") 'SHIP-TO STATE
        lstMaster.List(s, 99) = Cells(sat, "CV") 'SHIP-TO ZIP CODE
        lstMaster.List(s, 100) = Cells(sat, "CW") 'SHIP-TO COUNTRY
        lstMaster.List(s, 101) = Cells(sat, "CX") 'END USER NAME
        lstMaster.List(s, 102) = Cells(sat, "CY") 'EUID
        lstMaster.List(s, 103) = Cells(sat, "CZ") 'TIMESTAMP
        lstMaster.List(s, 104) = Cells(sat, "DA") 'CURRENT PROMISE DATE
        lstMaster.List(s, 105) = Cells(sat, "DB") 'CURRENT PROMISE MONTH
        s = s + 1
    End If
Next
Application.ScreenUpdating = True
lblProgResults = lstMaster.ListCount
End Sub
 

Attachments

  • Example of Search.jpg
    Example of Search.jpg
    291.8 KB · Views: 2

Yodelayheewho

Do You really would like to use something else than #4 reply solution.
Three lines or Your 106 lines ... hmm?
Code:
' You could test something like below to get shorter code instead Your code.
For sat ...
' Your code...
    if ....
' Your code...
        For c = 0 to 105
            lstMaster.List(s, c) = Cells(s, c+1)
        Next c
    EndIf
Next
 
I am always open for improvement and appreciate your insight. I am so new to VBA, that I'm not sure how to tackle this. Can you provide a little more guidance?
 

Yodelayheewho

You have there 107 lines like below
Code:
    lstMaster.AddItem
    lstMaster.List(s, 0) = Cells(sat, "A") 'PREFIX
'     and about 100 lines more
    lstMaster.List(s, 105) = Cells(sat, "DB") 'CURRENT PROMISE MONTH
Try to use below four lines
Code:
    lstMaster.AddItem
    For c = 0 to 105
        lstMaster.List(s, c) = Cells(s, c+1)
    Next c
 
Here's what I got, but if you look at the attached image it shows a runtime error. I tried adding: s = s + 1 after the error line and no luck, so I removed it. Thank you so much for hanging in there with me.

Code:
'***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
    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  '4 = first row of data NOT including column headers
    deg1 = Cells(sat, RN) 'Row Index = 'sat', RN is the Column Index? Number?
    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(s, c + 1) 'Run-time error '1004': Application-defined or object-defined error on: Cells(s, c + 1)
        Next c
    End If
Next
Application.ScreenUpdating = True
lblProgResults = lstMaster.ListCount
End Sub
 

Attachments

  • Runtime error 1004..jpg
    Runtime error 1004..jpg
    232 KB · Views: 1

Yodelayheewho

Sorry, but pictures won't help others at all.

As written Copy & Paste creates many times challenges ...
Code:
'   Your previous code was
        lstMaster.List(s, 105) = Cells(sat, "DB")
'    and it should work with ... same sat
    For c = 0 To 105 'column index
            lstMaster.List(s, c) = Cells(sat, c + 1) 
    Next c
... but I'm still wondering, why do You want to use those 106 columns if You can see/use max 10 columns?
 
... but I'm still wondering, why do You want to use those 106 columns if You can see/use max 10 columns?
When I search an order based on one of the (9) Cases, i.e, Shop Order, Suffix, etc. the results appear in the listbox. I click on the order I want. Then all of the data, which spans 106 columns, for that row populates the bottom half of the userform. So, I need to reference all of the columns so everything aligns.

I also agree that pictures are not always helpful. The file is too large to attach here, so I created a link to the file on DropBox so you can see the actual file.

I did make changes based on your suggestions in post #16. The search results only bring up the first order that matches the search. It does not bring up all of the orders that match.
Thank you vletm!
 

Yodelayheewho

You're using ActiveX-component - those won't work with me.
Above means ... I cannot even open Your form.
I quickly check Your code ... there should modify a lot of lines which has any reference with 106 columns.
including - if You'll save something from Your form.
... and why do You would like to 'rotate' something via form?
This could me much smoother without that form.
Ps. If You would save that file in .xlsb-format, then its size would be less than 600kB.
 
Hi vletm, I did read your entire post #18, but I thought by sending you the file, it would address your questions. I apologize that you got the impression that I ignored them. I hope the following helps.

You're using ActiveX-component - those won't work with me.
Would you explain why the ActiveX-component works for me, but not you?
there should modify a lot of lines which has any reference with 106 columns.
including - if You'll save something from Your form.
Are you asking if the data from the userform is saved to a worksheet? The data added/edited/deleted on the userform is saved to a worksheet titled: "Master"
This could me much smoother without that form.
By "this", do you mean the listbox or the entire userform.
I can't imagine not using the userform. The userform keeps the 106 columns-worth of data organized and makes entering data into the worksheet easier. I have multiple project meetings each week and we go over each of the active orders. When we discuss an order, I can quickly search for the order and see all of the detail in a very concise and organized way.
Before I added the listbox, the only way I could search orders was by the Shop Order Number. This wasn't enough, so I added the listbox feature, so I could search orders by additional criteria, i.e., PO number, Transfer number, Sales Order number, Customer Name etc.,
why do You would like to 'rotate' something via form?
Rotate something? I have no idea what you mean by 'rotate'.
 

Yodelayheewho

# ActiveX ... because my Excel cannot use those.
# Are you asking ... Your code has many times 106 columns with a listbox in UserForm, but Your're using nine.
For some reason it works for You, .AddItem to populate a listbox, you are limited to 10 columns.
In the beginning, You asked to do something to one part of Your code >> to use nine column with a listbox.
But - there are many other codes too - and that same modification should do with all of those.
# This could me much smoother without that form... entering data into the worksheet easier.
Rotate something?
You gotta 'move' data to userform - do something with it > 'move' data back to sheet
... instead to do something with sheet (without moving this-way-and-that-way)
You could see same nine columns with sheet while searching and so on.
Aren't those Your needed Search just visible columns in Your userform? ( as coded in #7 reply)
 
I can't imagine being without the userform. It's been a job-saver and my boss loves it.
Perhaps there is someone on this forum whose Excel can look at my file and see the userform in action?
 

Yodelayheewho

Because I cannot see Your forms ... I can see it without ... it.
But still, You have that challenge
... max ten columns in Listbox as You've used and You're using 106 columns.
>> If You would like to use it - then You should take care above.

I tested to do sample - how to see only those nine Your needed columns with sheet.
BUT
I tried to check/see Your file again and
... if I would offer something else then there would need to modify ... something.
So, it would be smoother for You to try to use Your logic.
 
Back
Top