Hiding rows - how can I speed this up?

[Myriad_Rocker]

I have a sub that goes through my sheet and hides certain rows. It takes FOREVER to run. I'm looking to speed it up. It's the actual hiding of the row that takes some time.

I thought about creating a new named range and adding to the named range in the loop and then issuing one hide command at the end. But I figured I'd get some other eyes on it so I could come up with the best solution.

Sub HideRows()
    Dim RowNum As Long
    Dim RowCnt As Long
    
    'Making sure we're on the right sheet
    Sheets("Weekly Sales Report").Select
    'The row we're starting on
    RowNum = 15
    RowCnt = 15
    'Get the number of rows to do
    Do Until IsEmpty(Range("B" & RowNum).Value)
        RowNum = RowNum + 1
    Loop
    
    Do Until Range("B" & RowCnt).Row = RowNum
        If Left(Range("B" & RowCnt).Value, 1) = " " Then
            Range("B" & RowCnt).EntireRow.Hidden = True
        Else
            Range("B" & RowCnt).EntireRow.Hidden = False
        End If
        RowCnt = RowCnt + 1
    Loop
    Range("AC1").Value = 1
End Sub

 

[VoG]

Try

Sub HideRows()
    Dim RowNum As Long
    Dim RowCnt As Long
    Application.ScreenUpdating = False
    'Making sure we're on the right sheet
    Sheets("Weekly Sales Report").Select
    'The row we're starting on
    RowNum = 15
    RowCnt = 15
    'Get the number of rows to do
    RowNum = Range("B" & Rows.Count).End(xlUp).Row
    
    Do Until Range("B" & RowCnt).Row = RowNum
        Rows(RowCnt).Hidden = Left(Range("B" & RowCnt).Value, 1) = " "
        RowCnt = RowCnt + 1
    Loop
    Range("AC1").Value = 1
    Application.ScreenUpdating = True
End Sub

 

[Jonmo1]

You should be able to cut the time in half at least...
You're looping through the range twice, once to find the last row, then to hide the rows...

Try like this

Dim LR As Long, RowCnt As Long, ws As Worksheet
Set ws = Sheets("Weekly Sales Report")
 
Application.SreenUpdating = False
With ws
    LR = .Cells(Rows.Count,"B").End(xlup).Row
    For RowCnt = 15 to LR
        .Rows(RowCnt).EntireRow.Hidden = Left(.Range("B" & RowCnt).Value, 1) = " "
    Next RowCnt
End With
Application.SreenUpdating = True

Hope that helps.

 

[Myriad_Rocker]

You should be able to cut the time in half at least...
You're looping through the range twice, once to find the last row, then to hide the rows...

Try like this

Dim LR As Long, RowCnt As Long, ws As Worksheet
Set ws = Sheets("Weekly Sales Report")
 
Application.SreenUpdating = False
With ws
    LR = .Cells(Rows.Count,"B").End(xlup).Row
    For RowCnt = 15 to LR
        .Rows(RowCnt).EntireRow.Hidden = Left(.Range("B" & RowCnt).Value, 1) = " "
    Next RowCnt
End With
Application.SreenUpdating = True

Hope that helps.

Yeah, that helps but it still takes about 20 seconds. It was taking about 40 seconds. So, yeah, about half the time. But I'd like for much much less. Like, 5 seconds, if that.

Hhhhmmm....I'm still hung up on making multiple selections via code and then issuing one hide command. I think that will speed it up significantly.

 

[Jonmo1]

You might also turn off events and calculation..

Dim LR As Long, RowCnt As Long, ws As Worksheet, PrevCalc As Variant
Set ws = Sheets("Weekly Sales Report")
 
With Application
    .SreenUpdating = False
    .EnableEvents = False
    PrevCalc = .Calculation
    .Calculation = xlCalculationManual
End With
 
With ws
    LR = .Cells(Rows.Count,"B").End(xlup).Row
    For RowCnt = 15 to LR
        .Rows(RowCnt).EntireRow.Hidden = Left(.Range("B" & RowCnt).Value, 1) = " "
    Next RowCnt
End With
 
With Application
    .SreenUpdating = True
    .EnableEvents = True
    .Calculation = PrevCalc
End With

 

[Myriad_Rocker]

You might also turn off events and calculation..

Dim LR As Long, RowCnt As Long, ws As Worksheet, PrevCalc As Variant
Set ws = Sheets("Weekly Sales Report")
 
With Application
    .SreenUpdating = False
    .EnableEvents = False
    PrevCalc = .Calculation
    .Calculation = xlCalculationManual
End With
 
With ws
    LR = .Cells(Rows.Count,"B").End(xlup).Row
    For RowCnt = 15 to LR
        .Rows(RowCnt).EntireRow.Hidden = Left(.Range("B" & RowCnt).Value, 1) = " "
    Next RowCnt
End With
 
With Application
    .SreenUpdating = True
    .EnableEvents = True
    .Calculation = PrevCalc
End With

That was already done previously in the code.

 

[Myriad_Rocker]

Here's my latest attempt, but it's bombing out on the named range definition.

Sub HideRows()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    Dim WS As Worksheet
    Dim RowNum As Long
    Dim RowSelections As String
    
    Set WS = Sheets("Weekly Sales Report")
    RowNum = 15
    
    With WS
        Do Until IsEmpty(Range("B" & RowNum).Value)
            If Left(Range("B" & RowNum).Value, 1) = " " Then
                RowSelections = RowSelections & "Weekly Sales Report!R" & RowNum & ","
            End If
            RowNum = RowNum + 1
        Loop
        RowSelections = Left(RowSelections, Len(RowSelections) - 1)
        ActiveWorkbook.Names.Add Name:="RowsToHide", RefersToR1C1:="=" & RowSelections
    End With
    Range(RowSelections).Select
    Range("AC1").Value = 1
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

 

[Jonmo1]

I would then suggest an alternate approach...without looping.

Put a formula in an available adjescent column..

=LEFT(B15,1)=" "

That will return True or False if the value in B15 begins with a space.

Then use AuotFilter on that column for False.

 

[Myriad_Rocker]

I would then suggest an alternate approach...without looping.

Put a formula in an available adjescent column..

=LEFT(B15,1)=" "

That will return True or False if the value in B15 begins with a space.

Then use AuotFilter on that column for False.

Good thought. I tried it but it doesn't look like that's going to work. I have about three pivot tables on the sheet that do the report and auto filter won't work on it.

 

[Colin Legg]

Perhaps hiding them all in one go rather than one at a time will be faster.

---> Show everything
---> Hide rows after row 14 where column B starts with " "

Sub HideRows()
 
    Const strTOFIND As String = " *"
    Dim rngToCheck As Range, rngFound As Range, rngToHide As Range
    Dim strFirstAddress As String
 
    Application.ScreenUpdating = False
 
    With Worksheets("Weekly Sales Report")
        Set rngToCheck = Intersect(.Range("B15:B" & .Rows.Count), .UsedRange)
    End With
 
    If Not rngToCheck Is Nothing Then
        With rngToCheck
 
            .EntireRow.Hidden = False
 
            Set rngFound = .Find( _
                                What:=strTOFIND, _
                                Lookat:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=True)
 
            If Not rngFound Is Nothing Then
                Set rngToHide = rngFound
 
                'note the address of the first found cell so we know where we started.
                strFirstAddress = rngFound.Address
 
                Set rngFound = .FindNext(After:=rngFound)
 
                Do Until rngFound.Address = strFirstAddress
                    Set rngToHide = Application.Union(rngToHide, rngFound)
                    Set rngFound = .FindNext(After:=rngFound)
                Loop
            End If
        End With
    End If
 
    If Not rngToHide Is Nothing Then rngToHide.EntireRow.Hidden = True
 
    Application.ScreenUpdating = True
End Sub