excelvba

VBA Procedure Too Large

I am encountering a "Procedure Too Large" error in VBA while using Private Sub Worksheet_Calculate() to automatically hide and unhide rows.

I need to set 275 trigger cells, but the procedure is too long, causing the error. Below is an example of my current approach using just 10 triggers:

Code Fragment:

Private Sub Worksheet_Calculate()
    Set iCell1 = 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

    If iCell1.Value = "FALSE1" Then
        Rows("38:68").Hidden = True
        Rows("10000:10000").Hidden = False
    ElseIf iCell1.Value = "TRUE1" Then
        Rows("38:68").Hidden = False
        Rows("10000:10000").Hidden = True
    End If

    ' Similar logic repeated for 275 triggers...

    Application.EnableEvents = True
End Sub

Since I have 275 triggers, the procedure becomes too long. What’s the best way to optimize this and avoid the "Procedure Too Large" error?

Potential Solutions I've Considered:

  1. Using a Loop – Can I store the trigger cells and row ranges in an array to dynamically process them?
  2. Splitting into Multiple Subroutines – Would breaking this into smaller subs help, and how would I structure it efficiently?
  3. Using Named Ranges or External Configuration – Is there a better way to store these trigger values dynamically?

I would greatly appreciate any guidance on the most efficient way to implement this.

Thank you!

Solution

  • 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
  ...