Yodelayheewho
Member
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!
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