Slow macro for hiding multiple rows. Any ideas for speeding it up?

[glad_ir]

Hello,

I wonder if I could get some help with this one please.

I am running the code below to hide rows in 14 areas of a sheet that don't have entries in their column E. It works but takes a long time to run (about 8 seconds)....as you can probably tell from the code I'm pretty new to VBA!

Does anybody have any suggestions for speeding it up? In an ideal world I'd like it to run fast enough that it can execute when the sheet in question is opened but probably needs to be <2-3 seconds for that otherwise users will get annoyed.

Any help is much appreciated.

Best regards,
Iain

Sub macroBIGTIDY()

    ActiveSheet.Unprotect
    Application.ScreenUpdating = False
    Dim Cl As Range
    For Each Cl In Range("e1447:e1475,e1419:e1437, e1347:e1375,e1319:e1337, e1247:e1275,e1219:e1237, e1119:e1137,e1147:e1175, e1019:e1037,e1047:e1075, e919:e937,e947:e975, e819:e837,e847:e875, e719:e737,e747:e775, e619:e637,e647:e675")
      If (Cl.Value = "") Then
         Cl.EntireRow.Hidden = True
      End If
    Next
      
    For Each Cl In Range("e519:e537,e547:e575, e419:e437,e447:e475, e319:e337,e347:e375, e219:e237,e247:e275, e119:e137,e147:e175")
      If (Cl.Value = "") Then
         Cl.EntireRow.Hidden = True
      End If
    Next
    
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        True

End Sub

 

[Peter_SSs]

Not sure how this will compare** but I think it should be considerably faster. Test with a copy of your workbook after you have added the rest of the row ranges in the code.
I have not tested as I don't have your data and the code is incomplete as mentioned above.

Sub Hide_Rows()
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
  
  a = Range("E1:E1475").Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    Select Case i
      Case 119 To 137, 147 To 175, 219 To 237, 247 To 275, 319 To 337, 347 To 375, 419 To 437, 447 To 475, _
            519 To 537, 547 To 575
        If Len(a(i, 1)) = 0 Then
          b(i, 1) = 1
          k = k + 1
        End If
    End Select
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect
    With Range("Z1").Resize(UBound(b))
      .Value = b
      .SpecialCells(xlConstants, xlNumbers).EntireRow.Hidden = True
      .ClearContents
    End With
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True
    Application.ScreenUpdating = True
  End If
End Sub

 

[mohadin]

Whta about

Sub macroBIGTIDY()

    ActiveSheet.Unprotect
    
    
   Range("e1447:e1475,e1419:e1437, e1347:e1375,e1319:e1337, e1247:e1275,e1219:e1237, e1119:e1137,e1147:e1175, e1019:e1037,e1047:e1075, e919:e937,e947:e975, e819:e837,e847:e875, e719:e737,e747:e775, e619:e637,e647:e675").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
     
    Range("e519:e537,e547:e575, e419:e437,e447:e475, e319:e337,e347:e375, e219:e237,e247:e275, e119:e137,e147:e175").EntireRow.Hidden = True
     
    
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        True

End Sub

 

[glad_ir]

Not sure how this will compare** but I think it should be considerably faster. Test with a copy of your workbook after you have added the rest of the row ranges in the code.
I have not tested as I don't have your data and the code is incomplete as mentioned above.

Sub Hide_Rows()
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
 
  a = Range("E1:E1475").Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    Select Case i
      Case 119 To 137, 147 To 175, 219 To 237, 247 To 275, 319 To 337, 347 To 375, 419 To 437, 447 To 475, _
            519 To 537, 547 To 575
        If Len(a(i, 1)) = 0 Then
          b(i, 1) = 1
          k = k + 1
        End If
    End Select
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect
    With Range("Z1").Resize(UBound(b))
      .Value = b
      .SpecialCells(xlConstants, xlNumbers).EntireRow.Hidden = True
      .ClearContents
    End With
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True
    Application.ScreenUpdating = True
  End If
End Sub

Hi,

Thank you so much for the response. This works perfectly on a fresh sheet.....but is failing when it gets to .Clear Contents on my real sheet (which is unprotected). Do you have any ideas what may be causing it?

thanks again,
Iain

 

[glad_ir]

Whta about

Sub macroBIGTIDY()

    ActiveSheet.Unprotect
   
   
   Range("e1447:e1475,e1419:e1437, e1347:e1375,e1319:e1337, e1247:e1275,e1219:e1237, e1119:e1137,e1147:e1175, e1019:e1037,e1047:e1075, e919:e937,e947:e975, e819:e837,e847:e875, e719:e737,e747:e775, e619:e637,e647:e675").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
    
    Range("e519:e537,e547:e575, e419:e437,e447:e475, e319:e337,e347:e375, e219:e237,e247:e275, e119:e137,e147:e175").EntireRow.Hidden = True
    
   
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        True

End Sub

Hi,

This works a treat and is super fast! Thank you

 

[Peter_SSs]

but is failing when it gets to .Clear Contents

Failing in what way?
- Not clearing the cells?
- Clearing the wrong cells?
- Error? (What error?)
- Something else?

The code worked on my test sheet.

 

[mohadin]

@glad_ir
You are welcome
And thank you for the feedback
Be happy & safe

 

[glad_ir]

Failing in what way?
- Not clearing the cells?
- Clearing the wrong cells?
- Error? (What error?)
- Something else?

The code worked on my test sheet.

Hi, it works well in a blank sheet but bugs out at the .clearance command line in my sheet for some reason. I have a lot going on in the sheet so likely linked to that.

Thank you very much for your help and the follow up. I really appreciate it.....have huge envy for you guys that can code like this. One day maybe!

cheers, Iain