Dynamically Hide/Unhide Multiple Ranges Using VBA With Minimal Lag

Question

I am trying to dynamically hide or unhide rows in a worksheet based off of selections within dropdown menus.

The script that I have works with smaller data sets, but because I have 35 different ranges of 26 rows each this slows down really quickly.

I have seen several solutions offered to similar question here, but I have been unable to get them to work.

I want to collect the value in cells B15 down to B41 and hide any rows that have a blank value, then repeat for the remaining 34 ranges.

Each of the cells in the range above have a formula that can return a "" value (which are the rows I want to hide).

Private Sub Worksheet_Change(ByVal Target As Range)

   'Turns off worksheet protection to allow for hiding and unhiding of rows
    ActiveSheet.Unprotect "xxxx"
   
   'Turns off screen updating and animations while hiding and unhiding rows
    Application.EnableAnimations = False
    Application.ScreenUpdating = False
      
    Hide1
    Hide2
    Hide3
    Hide4
    Hide5
    Hide6
    Hide7
    Hide8
    Hide9
    Hide10
    Hide11
    Hide12
    Hide13
    Hide14
    Hide15

    Application.ScreenUpdating = True
    Application.EnableAnimations = True
    
    ActiveSheet.Protect "xxxx"
    
End Sub

Sub Hide1()

Application.EnableEvents = False
Application.EnableAnimations = False
Application.ScreenUpdating = False

'Run #1

    If Range("B15").Value = "" Then
        Rows(15).EntireRow.Hidden = True
    Else
        Rows(15).EntireRow.Hidden = False
    End If
    If Range("B16").Value = "" Then
        Rows(16).EntireRow.Hidden = True
    Else
        Rows(16).EntireRow.Hidden = False
    End If
    If Range("B17").Value = "" Then
        Rows(17).EntireRow.Hidden = True
    Else
        Rows(17).EntireRow.Hidden = False
    End If
    If Range("B18").Value = "" Then
        Rows(18).EntireRow.Hidden = True
    Else
        Rows(18).EntireRow.Hidden = False
    End If
    If Range("B19").Value = "" Then
        Rows(19).EntireRow.Hidden = True
    Else
        Rows(19).EntireRow.Hidden = False
    End If
    If Range("B20").Value = "" Then
        Rows(20).EntireRow.Hidden = True
    Else
        Rows(20).EntireRow.Hidden = False
    End If
    If Range("B21").Value = "" Then
        Rows(21).EntireRow.Hidden = True
    Else
        Rows(21).EntireRow.Hidden = False
    End If
    If Range("B22").Value = "" Then
        Rows(22).EntireRow.Hidden = True
    Else
        Rows(22).EntireRow.Hidden = False
    End If
    If Range("B23").Value = "" Then
        Rows(23).EntireRow.Hidden = True
    Else
        Rows(23).EntireRow.Hidden = False
    End If
    If Range("B24").Value = "" Then
        Rows(24).EntireRow.Hidden = True
    Else
        Rows(24).EntireRow.Hidden = False
    End If
    If Range("B25").Value = "" Then
        Rows(25).EntireRow.Hidden = True
    Else
        Rows(25).EntireRow.Hidden = False
    End If
    If Range("B26").Value = "" Then
        Rows(26).EntireRow.Hidden = True
    Else
        Rows(26).EntireRow.Hidden = False
    End If
    If Range("B27").Value = "" Then
        Rows(27).EntireRow.Hidden = True
    Else
        Rows(27).EntireRow.Hidden = False
    End If
    If Range("B28").Value = "" Then
        Rows(28).EntireRow.Hidden = True
    Else
        Rows(28).EntireRow.Hidden = False
    End If
    If Range("B29").Value = "" Then
        Rows(29).EntireRow.Hidden = True
    Else
        Rows(29).EntireRow.Hidden = False
    End If
    If Range("B30").Value = "" Then
        Rows(30).EntireRow.Hidden = True
    Else
        Rows(30).EntireRow.Hidden = False
    End If
    If Range("B31").Value = "" Then
        Rows(31).EntireRow.Hidden = True
    Else
        Rows(31).EntireRow.Hidden = False
    End If

    Application.EnableEvents = True
    Application.EnableAnimations = True
    Application.ScreenUpdating = True
    
End Sub

Answer 1

Please, try the next code. As it is set, it will hide all rows having empty values returned by a formula. firstR and lastR can be chosen to process a specific number of rows:

Sub Hide1()
 Dim sh As Worksheet, lastR As Long, firstR As Long
 Dim rng As Range, rngH As Range, arr, i As Long
 
 Set sh = ActiveSheet 'use here the sheet you need
 lastR = sh.Range("B" & sh.rows.Count).End(xlUp).row 'last row on B:B
 firstR = 15          'first row of the range to be processed
 Set rng = sh.Range("B" & firstR & ":B" & lastR)
 rng.EntireRow.Hidden = False       'show all rows in the range

 arr = rng.Value                    'place the range in an array for faster iteration
 For i = 1 To UBound(arr)
    If arr(i, 1) = "" Then
        If rngH Is Nothing Then    'set the range to keep the cells where the rows must be hidden
            Set rngH = rng.cells(i, 1)
        Else
           Set rngH = Union(rngH, rng.cells(i, 1))
        End If
    End If
 Next
 'hide the rows at once:
 If Not rngH Is Nothing Then rngH.EntireRow.Hidden = True
End Sub

Answer 2

Hide Blank Rows

• Adjust the values in the constants section.

Option Explicit

Sub HideBlankRows()
    
    Const fCellAddress As String = "B16"
    Const crgCount As Long = 35
    Const crgSize As Long = 16 ' maybe 26 ?
    Const crgGap As Long = 5
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    
    Dim crg As Range: Set crg = ws.Range(fCellAddress).Resize(crgSize)
    Dim crgOffset As Long: crgOffset = crgSize + crgGap
    Dim rg As Range: Set rg = crg
    
    Dim n As Long
    For n = 2 To crgCount
        Set crg = crg.Offset(crgOffset)
        Set rg = Union(rg, crg)
    Next n
    
    Dim drg As Range
    Dim cCell As Range
    
    For Each cCell In rg.Cells
        If Len(CStr(cCell.Value)) = 0 Then
            If drg Is Nothing Then
                Set drg = cCell
            Else
                Set drg = Union(drg, cCell)
            End If
        End If
    Next cCell
    If drg Is Nothing Then Exit Sub
 
    rg.EntireRow.Hidden = False
    drg.EntireRow.Hidden = True
    
End Sub