would anyone help me to resolve my problem related to the Procedure Too Large error in VBA?
I'm using Private Sub Worksheet_Calculate() to hide and unhide rows automatically and there are 275 cells that I would like to set for the triggers. The example below are just shown for 10 triggers cell, and I'd like to create 275 triggers cells
Code fragment
`Private Sub Worksheet_Calculate()
Set iCell = Range("G38")
Set iCell2 = Range("G70")
Set iCell3 = Range("G102")
Set iCell4 = Range("G134")
Set iCell5 = Range("G166")
Set iCell6 = Range("G198")
Set iCell7 = Range("G230")
Set iCell8 = Range("G262")
Set iCell9 = Range("G294")
Set iCell10 = Range("G326")
Application.EnableEvents = False
byFALSE1Hidden = Rows("38:68").Hidden
byTRUE1Hidden = Rows("10000:10000").Hidden
' New logic for trigger 2
byFALSE2Hidden = Rows("70:100").Hidden
byTRUE2Hidden = Rows("10001:10001").Hidden
' New logic for trigger 3
byFALSE3Hidden = Rows("102:132").Hidden
byTRUE3Hidden = Rows("10002:10002").Hidden
' New logic for trigger 4
byFALSE4Hidden = Rows("134:164").Hidden
byTRUE4Hidden = Rows("10003:10003").Hidden
' New logic for trigger 5
byFALSE5Hidden = Rows("166:196").Hidden
byTRUE5Hidden = Rows("10004:10004").Hidden
' New logic for trigger 6
byFALSE6Hidden = Rows("198:228").Hidden
byTRUE6Hidden = Rows("10005:10005").Hidden
' New logic for trigger 7
byFALSE7Hidden = Rows("230:260").Hidden
byTRUE7Hidden = Rows("10006:10006").Hidden
' New logic for trigger 8
byFALSE8Hidden = Rows("262:292").Hidden
byTRUE8Hidden = Rows("10007:10007").Hidden
' New logic for trigger 9
byFALSE9Hidden = Rows("294:324").Hidden
byTRUE9Hidden = Rows("10008:10008").Hidden
' New logic for trigger 10
byFALSE10Hidden = Rows("326:356").Hidden
byTRUE10Hidden = Rows("10009:10009").Hidden
If iCell.value = "FALSE1" Then
If Not byFALSE1Hidden Then
Rows("38:68").Hidden = True
Rows("10000:10000").Hidden = False
End If
ElseIf iCell.value = "TRUE1" Then
If Not byTRUE1Hidden Then
Rows("38:68").Hidden = False
Rows("10000:10000").Hidden = True
End If
End If
' New logic for trigger 2
If iCell2.value = "FALSE2" Then
If Not byFALSE2Hidden Then
Rows("70:100").Hidden = True
Rows("10001:10001").Hidden = False
End If
ElseIf iCell2.value = "TRUE2" Then
If Not byTRUE2Hidden Then
Rows("70:100").Hidden = False
Rows("10001:10001").Hidden = True
End If
End If
' New logic for trigger 3
If iCell3.value = "FALSE3" Then
If Not byFALSE3Hidden Then
Rows("102:132").Hidden = True
Rows("10002:10002").Hidden = False
End If
ElseIf iCell3.value = "TRUE3" Then
If Not byTRUE3Hidden Then
Rows("102:132").Hidden = False
Rows("10002:10002").Hidden = True
End If
End If
' New logic for trigger 4
If iCell4.value = "FALSE4" Then
If Not byFALSE4Hidden Then
Rows("134:164").Hidden = True
Rows("10003:10003").Hidden = False
End If
ElseIf iCell4.value = "TRUE4" Then
If Not byTRUE4Hidden Then
Rows("134:164").Hidden = False
Rows("10003:10003").Hidden = True
End If
End If
' New logic for trigger 5
If iCell5.value = "FALSE5" Then
If Not byFALSE5Hidden Then
Rows("166:196").Hidden = True
Rows("10004:10004").Hidden = False
End If
ElseIf iCell5.value = "TRUE5" Then
If Not byTRUE5Hidden Then
Rows("166:196").Hidden = False
Rows("10004:10004").Hidden = True
End If
End If
' New logic for trigger 6
If iCell6.value = "FALSE6" Then
If Not byFALSE6Hidden Then
Rows("198:228").Hidden = True
Rows("10005:10005").Hidden = False
End If
ElseIf iCell6.value = "TRUE6" Then
If Not byTRUE6Hidden Then
Rows("198:228").Hidden = False
Rows("10005:10005").Hidden = True
End If
End If
' New logic for trigger 7
If iCell7.value = "FALSE7" Then
If Not byFALSE7Hidden Then
Rows("230:260").Hidden = True
Rows("10006:10006").Hidden = False
End If
ElseIf iCell7.value = "TRUE7" Then
If Not byTRUE7Hidden Then
Rows("230:260").Hidden = False
Rows("10006:10006").Hidden = True
End If
End If
' New logic for trigger 8
If iCell8.value = "FALSE8" Then
If Not byFALSE8Hidden Then
Rows("262:292").Hidden = True
Rows("10007:10007").Hidden = False
End If
ElseIf iCell8.value = "TRUE8" Then
If Not byTRUE8Hidden Then
Rows("262:292").Hidden = False
Rows("10007:10007").Hidden = True
End If
End If
' New logic for trigger 9
If iCell9.value = "FALSE9" Then
If Not byFALSE9Hidden Then
Rows("294:324").Hidden = True
Rows("10008:10008").Hidden = False
End If
ElseIf iCell9.value = "TRUE9" Then
If Not byTRUE9Hidden Then
Rows("294:324").Hidden = False
Rows("10008:10008").Hidden = True
End If
End If
' New logic for trigger 10
If iCell10.value = "FALSE10" Then
If Not byFALSE10Hidden Then
Rows("326:356").Hidden = True
Rows("10009:10009").Hidden = False
End If
ElseIf iCell10.value = "TRUE10" Then
If Not byTRUE10Hidden Then
Rows("326:356").Hidden = False
Rows("10009:10009").Hidden = True
End If
End If
Application.EnableEvents = True
End Sub
Thank you.
would anyone help me to resolve my problem related to the Procedure Too Large error in VBA?
I'm using Private Sub Worksheet_Calculate() to hide and unhide rows automatically and there are 275 cells that I would like to set for the triggers. The example below are just shown for 10 triggers cell, and I'd like to create 275 triggers cells
Code fragment
`Private Sub Worksheet_Calculate()
Set iCell = Range("G38")
Set iCell2 = Range("G70")
Set iCell3 = Range("G102")
Set iCell4 = Range("G134")
Set iCell5 = Range("G166")
Set iCell6 = Range("G198")
Set iCell7 = Range("G230")
Set iCell8 = Range("G262")
Set iCell9 = Range("G294")
Set iCell10 = Range("G326")
Application.EnableEvents = False
byFALSE1Hidden = Rows("38:68").Hidden
byTRUE1Hidden = Rows("10000:10000").Hidden
' New logic for trigger 2
byFALSE2Hidden = Rows("70:100").Hidden
byTRUE2Hidden = Rows("10001:10001").Hidden
' New logic for trigger 3
byFALSE3Hidden = Rows("102:132").Hidden
byTRUE3Hidden = Rows("10002:10002").Hidden
' New logic for trigger 4
byFALSE4Hidden = Rows("134:164").Hidden
byTRUE4Hidden = Rows("10003:10003").Hidden
' New logic for trigger 5
byFALSE5Hidden = Rows("166:196").Hidden
byTRUE5Hidden = Rows("10004:10004").Hidden
' New logic for trigger 6
byFALSE6Hidden = Rows("198:228").Hidden
byTRUE6Hidden = Rows("10005:10005").Hidden
' New logic for trigger 7
byFALSE7Hidden = Rows("230:260").Hidden
byTRUE7Hidden = Rows("10006:10006").Hidden
' New logic for trigger 8
byFALSE8Hidden = Rows("262:292").Hidden
byTRUE8Hidden = Rows("10007:10007").Hidden
' New logic for trigger 9
byFALSE9Hidden = Rows("294:324").Hidden
byTRUE9Hidden = Rows("10008:10008").Hidden
' New logic for trigger 10
byFALSE10Hidden = Rows("326:356").Hidden
byTRUE10Hidden = Rows("10009:10009").Hidden
If iCell.value = "FALSE1" Then
If Not byFALSE1Hidden Then
Rows("38:68").Hidden = True
Rows("10000:10000").Hidden = False
End If
ElseIf iCell.value = "TRUE1" Then
If Not byTRUE1Hidden Then
Rows("38:68").Hidden = False
Rows("10000:10000").Hidden = True
End If
End If
' New logic for trigger 2
If iCell2.value = "FALSE2" Then
If Not byFALSE2Hidden Then
Rows("70:100").Hidden = True
Rows("10001:10001").Hidden = False
End If
ElseIf iCell2.value = "TRUE2" Then
If Not byTRUE2Hidden Then
Rows("70:100").Hidden = False
Rows("10001:10001").Hidden = True
End If
End If
' New logic for trigger 3
If iCell3.value = "FALSE3" Then
If Not byFALSE3Hidden Then
Rows("102:132").Hidden = True
Rows("10002:10002").Hidden = False
End If
ElseIf iCell3.value = "TRUE3" Then
If Not byTRUE3Hidden Then
Rows("102:132").Hidden = False
Rows("10002:10002").Hidden = True
End If
End If
' New logic for trigger 4
If iCell4.value = "FALSE4" Then
If Not byFALSE4Hidden Then
Rows("134:164").Hidden = True
Rows("10003:10003").Hidden = False
End If
ElseIf iCell4.value = "TRUE4" Then
If Not byTRUE4Hidden Then
Rows("134:164").Hidden = False
Rows("10003:10003").Hidden = True
End If
End If
' New logic for trigger 5
If iCell5.value = "FALSE5" Then
If Not byFALSE5Hidden Then
Rows("166:196").Hidden = True
Rows("10004:10004").Hidden = False
End If
ElseIf iCell5.value = "TRUE5" Then
If Not byTRUE5Hidden Then
Rows("166:196").Hidden = False
Rows("10004:10004").Hidden = True
End If
End If
' New logic for trigger 6
If iCell6.value = "FALSE6" Then
If Not byFALSE6Hidden Then
Rows("198:228").Hidden = True
Rows("10005:10005").Hidden = False
End If
ElseIf iCell6.value = "TRUE6" Then
If Not byTRUE6Hidden Then
Rows("198:228").Hidden = False
Rows("10005:10005").Hidden = True
End If
End If
' New logic for trigger 7
If iCell7.value = "FALSE7" Then
If Not byFALSE7Hidden Then
Rows("230:260").Hidden = True
Rows("10006:10006").Hidden = False
End If
ElseIf iCell7.value = "TRUE7" Then
If Not byTRUE7Hidden Then
Rows("230:260").Hidden = False
Rows("10006:10006").Hidden = True
End If
End If
' New logic for trigger 8
If iCell8.value = "FALSE8" Then
If Not byFALSE8Hidden Then
Rows("262:292").Hidden = True
Rows("10007:10007").Hidden = False
End If
ElseIf iCell8.value = "TRUE8" Then
If Not byTRUE8Hidden Then
Rows("262:292").Hidden = False
Rows("10007:10007").Hidden = True
End If
End If
' New logic for trigger 9
If iCell9.value = "FALSE9" Then
If Not byFALSE9Hidden Then
Rows("294:324").Hidden = True
Rows("10008:10008").Hidden = False
End If
ElseIf iCell9.value = "TRUE9" Then
If Not byTRUE9Hidden Then
Rows("294:324").Hidden = False
Rows("10008:10008").Hidden = True
End If
End If
' New logic for trigger 10
If iCell10.value = "FALSE10" Then
If Not byFALSE10Hidden Then
Rows("326:356").Hidden = True
Rows("10009:10009").Hidden = False
End If
ElseIf iCell10.value = "TRUE10" Then
If Not byTRUE10Hidden Then
Rows("326:356").Hidden = False
Rows("10009:10009").Hidden = True
End If
End If
Application.EnableEvents = True
End Sub
Thank you.
Share edited 2 days ago Shrotter 6291 gold badge5 silver badges17 bronze badges asked 2 days ago Ni Luh Sila DewiNi Luh Sila Dewi 34 bronze badges 10 | Show 5 more comments2 Answers
Reset to default 1Option Explicit
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
HideShow "FALSE1", 38, 68, "TRUE1", 10000 ' trigger 1
HideShow "FALSE2", 70, 100, "TRUE2", 10001 ' trigger 2
HideShow "FALSE3", 102, 132, "TRUE3", 10002 ' trigger 3
HideShow "FALSE4", 134, 164, "TRUE4", 10003 ' trigger 4
HideShow "FALSE5", 166, 196, "TRUE5", 10004 ' trigger 5
HideShow "FALSE6", 198, 228, "TRUE6", 10005 ' trigger 6
HideShow "FALSE7", 230, 260, "TRUE7", 10006 ' trigger 7
HideShow "FALSE8", 262, 292, "TRUE8", 10007 ' trigger 8
HideShow "FALSE9", 294, 324, "TRUE9", 10008 ' trigger 9
HideShow "FALSE10", 326, 356, "TRUE10", 10009 ' trigger 10
Application.EnableEvents = True
End Sub
Sub HideShow(sFalse As String, r1start As Long, r1end As Long, sTrue As String, r2 As Long)
Dim rng1 As Range, rng2 As Range
Set rng1 = Rows(r1start).Resize(r1end - r1start + 1)
Set rng2 = Rows(r2)
If Cells(r1start, "G").Value = sFalse Then
If rng1.Hidden = False Then
rng1.Hidden = True
rng2.Hidden = False
End If
ElseIf Cells(r1start, "G").Value = sTrue Then
If rng2.Hidden = False Then
rng1.Hidden = False
rng2.Hidden = True
End If
End If
End Sub
If you have 275 values put them into 5 columns on another (hidden) sheet like this
FALSE1 38 68 TRUE1 10000
FALSE2 70 100 TRUE2 10001
FALSE3 102 132 TRUE3 10002
FALSE4 134 164 TRUE4 10003
FALSE5 166 196 TRUE5 10004
FALSE6 198 228 TRUE6 10005
FALSE7 230 260 TRUE7 10006
FALSE8 262 292 TRUE8 10007
FALSE9 294 324 TRUE9 10008
FALSE10 326 356 TRUE10 10009
and then the code becomes
Private Sub Worksheet_Calculate()
Dim ar As Variant
Dim r As Long, r1start As Long, r1end As Long, r2 As Long
Dim sFalse As String, sTrue As String
ar = Sheets("Sheet2").Range("A1:E275").Value
Application.EnableEvents = False
For r = 1 To UBound(ar)
sFalse = CStr(ar(r, 1))
r1start = CLng(ar(r, 2))
r1end = CLng(ar(r, 3))
sTrue = CStr(ar(r, 4))
r2 = CLng(ar(r, 5))
Call HideShow(sFalse, r1start, r1end, sTrue, r2)
Next
Application.EnableEvents = True
End Sub
You can shorten the sub using the cycle:
Option Explicit
Option Base 1
Private Sub Worksheet_Calculate()
Dim aTrue, aFalse, i&, k&, n&
aTrue = Array("TRUE1", "TRUE2", "TRUE3", "TRUE4", "TRUE5", "TRUE6", "TRUE7", "TRUE8", "TRUE9", "TRUE10")
aFalse = Array("FALSE1", "FALSE2", "FALSE3", "FALSE4", "FALSE5", "FALSE6", "FALSE7", "FALSE8", "FALSE9", "FALSE10")
Application.EnableEvents = False
For i = 1 To UBound(aTrue)
k = 6 + 32 * i: n = 9999 + i
If Cells(k, "G").Value = aFalse(i) And Not Rows(k).Hidden Then
Rows(k & ":" & (30 + k)).Hidden = True
Rows(n).Hidden = False
End If
With Rows(n)
If Cells(k, "G").Value = aTrue(i) And Not .Hidden Then
Rows(k & ":" & (30 + k)).Hidden = False
.Hidden = True
End If
End With
Next
Application.EnableEvents = True
End Sub
For "some different number of gaps in the triggers" use:
Dim aNumbers, j&
j = UBound(aTrue)
ReDim aNumbers(j)
' Generate the regular sequence
For i = 1 To j
aNumbers(i) = 6 + 32 * i
Next
' Substitute some numbers
aNumbers(3) = 11
aNumbers(7) = 22
...
If Cells(aNumbers(i), "G").Value = aFalse(i) Then
...
{}button in the editor. It would also help if you explained what this code is doing, or what you want it to do. It looks highly inefficient and could likely be replaced with some loops, arrays/dictionaries, and functions to make it small and manageable. – JNevill Commented 2 days agoiCell, iCell2, iCell3, byFALSE1Hidden, byTRUE1Hidden,byFALSE2Hidden, byTRUE2Hidden,byFALSE3Hidden, byTRUE3Hidden– CDP1802 Commented 2 days ago