VBA Running slow

[Rab_marr]

Good afternoon everyone,

I have been playing around with some simple VBA code and come across this one in the forum that hides all rows where there is a "0" in the cells of column J:

Sub Hide()
Application.ScreenUpdating = False


Dim wks As Worksheet
Dim Lastrow As String
Dim Rng As Range
Dim cell As Range


On Error Resume Next
For Each wks In ThisWorkbook.Worksheets

With wks
wks.Select
Rows.Hidden = False
Lastrow = Range("J" & Rows.Count).End(xlUp).Row '
Set Rng = Range("J2:J" & Lastrow) 'choose column where value exists
For Each cell In Rng
If cell.Value = "0" Then 'Change the value based on which the rows need to be hidden
cell.EntireRow.Hidden = True
End If
Next cell
End With
Next wks


Application.ScreenUpdating = True
End Sub

The problem is when I run it, it can take up to 5 minutes to complete. I have guessed that perhaps the VBA is searching all 1,000,000+ rows and tried to change the range to just the 300 lines required. I also changed the criteria to search for "1" instead of "0", but with no success.

Is there something I have overlooked or is this just one of the codes that takes a while to complete?

Many thanks for any assistance that you can give

Rgds

 

[BarryL]

if you have loads of data and formulas with automatic calculation I imagine the above is quite tasking.... hiding row by row doesn't seem optimal. try the below it should be quicker

Sub Hide_Zero()
  Dim a, b
  Dim nc As Long, i As Long
 
  nc = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, SearchFormat:=False).Column + 1
  a = Range("J1", Range("J" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) = 0 Then b(i, 1) = 1
  Next i
  Application.ScreenUpdating = False
  With Range("A1").Resize(UBound(a), nc)
    .Columns(nc).Value = b
     On Error Resume Next
    .Columns(nc).SpecialCells(xlConstants).EntireRow.Hidden = True
    On Error GoTo 0
  End With
  Application.ScreenUpdating = True
End Sub

 

[Rab_marr]

Excellent,

That's rapid.

Thanks Barry

Rab

 

[BarryL]

glad to help