CODEWITHSUNDEEP
excelvba
Valantic
Valantic

Reputation: 15

VBA - Speed of Hiding/Unhiding Row as a Worksheet Event

I'm struggling with the speed at which the following VBA code executes.

The goal of this code is to activate whenever "C4" changes, and then scan column "R" for the value 'Y'. If there's a 'Y', then it hides the row, and if not, it unhides the row. The code works, it's just not speedy - for 500 rows, it can take 30 or more seconds every time I change the value of "C4".

Does anyone have any suggestions to improve the speed at which this code executes? Or another method of accomplishing this?

Thanks for taking a look.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim L As Long
Dim r As Range

L = Cells(Rows.Count, "R").End(xlUp).Row

If Not Intersect(Target, Range("C4")) Is Nothing Then
    For Each r In Range("R2:R" & L)
        If r.Value = "Y" Then
            Rows(r.Row).Hidden = True
        Else
            Rows(r.Row).Hidden = False
        End If
    Next
End If

End Sub

In attempting to apply the suggestion below - use Union() - I have come up with the below, not working, code. Any help would be greatly appreciated. 

Private Sub Worksheet_Change(ByVal Target As Range)

Dim L As Long
Dim r As Range
Dim RowsToHide As Range
Dim RowsToUnhide As Range

L = Cells(Rows.Count, "R").End(xlUp).Row

If Not Intersect(Target, Range("C4")) Is Nothing Then
    For Each r In Range("R2:R" & L)
        If r.Value = "Y" Then
            RowsToHide = Union(RowsToHide, r.Row)
        Else
            RowsToUnhide = Union(RowsToUnhide, r.Row)
        End If
    Next
End If

RowsToHide.Hidden = True
RowsToUnhide.Hidden = False

End Sub

Upvotes: 1

Views: 82

Answers (2)

chris neilsen
chris neilsen

Reputation: 53126

There are several techniques that will help speed this up

  • Writing to .Hidden is much slower than reading it. So check if the row is already hidden or showing before setting Hidden
  • Collect the rows to Hide or Show into a range (Union) and Hide/Show tehm in one go. 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    Dim rngCheck As Range
    Dim rngHide As Range, rngShow As Range

    Application.ScreenUpdating = False
    If Not Intersect(Target, Me.Range("C1")) Is Nothing Then
        Set rngCheck = Me.Range(Me.Cells(1, "R"), Me.Cells(Me.Rows.Count, "R").End(xlUp))
        For Each r In rngCheck.Cells
            If r.Value2 = "Y" Then
                If Not r.EntireRow.Hidden Then
                    If rngHide Is Nothing Then
                        Set rngHide = r.EntireRow
                    Else
                        Set rngHide = Union(rngHide, r.EntireRow)
                    End If
                End If
            Else
                If r.EntireRow.Hidden Then
                    If rngShow Is Nothing Then
                        Set rngShow = r.EntireRow
                    Else
                        Set rngShow = Union(rngShow, r.EntireRow)
                    End If
                End If
            End If
        Next
    End If

    If Not rngHide Is Nothing Then
        rngHide.EntireRow.Hidden = True
    End If
    If Not rngShow Is Nothing Then
        rngShow.EntireRow.Hidden = False
    End If

    Application.ScreenUpdating = True

End Sub

Upvotes: 1

Zack E
Zack E

Reputation: 706

Adding Application.EnableEvents = False at the beginning of the code then turning back to true will help, Also using Applciation.ScreenUpdating = False should help as well.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim L As Long
Dim r As Range

Application.EnableEvents = False
Application.ScreenUpdating = False

L = Cells(Rows.Count, "R").End(xlUp).Row

If Not Intersect(Target, Range("C4")) Is Nothing Then
    For Each r In Range("R2:R" & L)
        If r.Value = "Y" Then
            Rows(r.Row).Hidden = True
        Else
            Rows(r.Row).Hidden = False
        End If
    Next
End If

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Upvotes: 2

Related Questions