CODEWITHSUNDEEP
excelvba
FBeckenbauer4
FBeckenbauer4

Reputation: 27

Excel VBA Toggle Hide/Unhide code takes too long

I'm hoping to speed up the 1st code below that takes too long to complete. It just hides/unhides Rows if a cell in Column H contains the text: "Header". I've got a better code below that(from stack) that I use regularly to toggle ranges but I can't seem to adjust it to IFs. I have too many named ranges already.

Sub Hide_Columns_Toggle()
    Dim c As Range
    
    For Each c In Columns("H:H").Cells
        If c.Value = "Header" Then
        c.EntireRow.Hidden = Not c.EntireRow.Hidden
        End If
    Next c 
End Sub

Regular code for ranges:

Sub ToggleHiddenRow(rng As Range)
  With rng.EntireRow
    .Hidden = Not .Hidden
  End With
End Sub


Sub Name_1()
        ToggleHiddenRow ActiveSheet.Range("Named_Range_1")
End Sub

Any help is much much appreciated.

Upvotes: 0

Views: 282

Answers (3)

Tim Williams
Tim Williams

Reputation: 166381

Here's what I meant:

Sub ToggleRowsVis()
    Dim rngHide As Range, rngShow As Range, c As Range, rw As Range
    For Each c In ActiveSheet.Range("Names").Cells
        If c.Value = "Header" Then
            Set rw = c.EntireRow
            If rw.Hidden Then
                BuildRange rngShow, c.EntireRow
            Else
                BuildRange rngHide, c.EntireRow
            End If
        End If
    Next c
    If Not rngHide Is Nothing Then rngHide.Rows.Hidden = True
    If Not rngShow Is Nothing Then rngShow.Rows.Hidden = False
End Sub

'utility sub for building ranges using Union
Sub BuildRange(ByRef rngTot As Range, rngAdd As Range)
    If rngTot Is Nothing Then
        Set rngTot = rngAdd
    Else
        Set rngTot = Application.Union(rngTot, rngAdd)
    End If
End Sub

Upvotes: 1

chris neilsen
chris neilsen

Reputation: 53126

To speed this up you can:

  1. Limit the number of cells you reference on the sheet
  2. Hide/Unhide all the required rows in one operation
  3. Only Hide/Unhide rows you want to change the visibility on

The code achieves this by

  1. Creates a Range that extends from the last tested row to the sheet end
  2. Uses Match to locate the next cell containing the test value
  3. Tests if the row visibility needs to be changed
  4. Tracks two sets of ranges, one to be hidden and the other to be unhidden
  5. Applies the Hide/Unhide to all rows at once
  6. Generalises the code to allow you to specify Worksheet, Column, TestValue and Hide Mode
Option Explicit

Enum HideMode
    Hide = 0
    Show = 1
    Toggle = 2
End Enum
 
Sub Demo()
    Hide_Columns_Toggle 8, "Header", HideMode.Toggle
End Sub

Sub Hide_Columns_Toggle(Col As Long, TestValue As Variant, Mode As HideMode, Optional ws As Worksheet)
    Dim rng As Range
    Dim rToHide As Range
    Dim rToShow As Range
    Dim rw As Variant
    
    ' Default to ActiveSheet
    If ws Is Nothing Then Set ws = ActiveSheet
    
    Set rng = ws.Range(ws.Cells(1, Col), ws.Cells(ws.Rows.Count, Col))
    rw = Application.Match(TestValue, rng, 0)
    Do Until IsError(rw)
        Select Case Mode
            Case HideMode.Toggle
                If rng.Cells(rw, 1).EntireRow.Hidden = True Then
                    AddToRange rToShow, rng.Cells(rw, 1)
                Else
                    AddToRange rToHide, rng.Cells(rw, 1)
                End If
            Case HideMode.Hide
                If rng.Cells(rw, 1).EntireRow.Hidden = False Then
                    AddToRange rToHide, rng.Cells(rw, 1)
                End If
            Case HideMode.Show
                If rng.Cells(rw, 1).EntireRow.Hidden = True Then
                    AddToRange rToShow, rng.Cells(rw, 1)
                End If
        End Select
        Set rng = ws.Range(rng.Cells(rw + 1, 1), ws.Cells(ws.Rows.Count, Col))
        rw = Application.Match(TestValue, rng, 0)
    Loop
    
    If Not rToHide Is Nothing Then
        rToHide.EntireRow.Hidden = True
    End If
    If Not rToShow Is Nothing Then
        rToShow.EntireRow.Hidden = False
    End If
End Sub

Private Sub AddToRange(rng As Range, AddRange As Range)
    If rng Is Nothing Then
        Set rng = AddRange
    Else
        Set rng = Application.Union(rng, AddRange)
    End If
End Sub

Upvotes: 2

FBeckenbauer4
FBeckenbauer4

Reputation: 27

Ok I think I found a middle ground with your guys' inspiration, I'll just have H1:H3000 as a named range(Names) and then use that 1 range to sift through different text that I can put in there(Header/Detail etc).

Sub Hide_Columns_Toggle2()

    For Each c In ActiveSheet.Range("Names")
        If c.Value = "Header" Then
        c.EntireRow.Hidden = Not c.EntireRow.Hidden
        End If
    Next c
End Sub

Thank guys.

Upvotes: 0

Related Questions