Very Long Loop

Smoakstack

Board Regular
Joined
Mar 28, 2011
Messages
79
I am looking for zeros and hiding column data to make table less cumbersome. here is my code:

Dim A as Range
Dim B as Range
Dim C as Range
Dim D as Range

For Each C In Sheets("Elevations").Range("M400:XX400")
If (C.Value = 0) Then
C.EntireColumn.Hidden = True
Else
C.EntireColumn.Hidden = False
End If
Next C

For Each B In Sheets("Elevations").Range("b9:b400")
If (B.Value = 0) Then
B.EntireRow.Hidden = True
Else
B.EntireRow.Hidden = False
End If
Next B


I have several sheets that these codes are running on, but it takes soo long. Is there a way to make it less of a wait using an array of some sort?
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
What are all of your ranges that you need to test?
 
Upvote 0
I have 10 sheets.
Sheet 1 B9:B400, M400:XX400
Sheet 4 .Range("D8:D37,D55:D78,D85:D90,D107:D109,D111:D120")
Sheet 5 Range ("D8:D43,D161:D184,D190:D213,D220:D225,D242:D244,D246:D255")
Sheet 6 ("D8:D37,D129:D152,D155:D178,D185:D190,D207:D209,D211:D220")
Sheet 7 ("D8:D22,D96:D119,D129:D134,D153:D155,D157:D160")
Sheet 8 Range("D8:D22,D40:D57,D84:D86,D88:D97")
Sheet 9 Range("D8:D31,D49:D66,D93:D95")

it would be greatly appreciated
 
Upvote 0
Reason I have the Else in there is so that If I paste new data in one of my sheets, I can always update. I know this takes some extra time on the loop, but that is why I am trying to shorten it.
 
Upvote 0
It looks like you're essentially testing the entire column D in sheets 4 through 9.

Try out this code:

Code:
Public Sub Smoakstack()
Dim rng             As Range, _
    rng1            As String, _
    i               As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")
    .Rows("1:" & Rows.Count).Hidden = False
    With .Range("B9:B400")
        Set rng = .Find("0", LookIn:=xlValues, LookAt:=xlWhole)
        If Not rng Is Nothing Then
            rng1 = rng.Address
            Do
                rng.EntireRow.Hidden = True
                Set rng = .FindNext(rng)
            Loop While Not rng Is Nothing And rng.Address <> rng1
        End If
    End With
    Set rng = Nothing
End With
With Sheets("Sheet1")
    .Rows("1:" & Rows.Count).Hidden = False
    With .Range("M400:XX400")
        Set rng = .Find("0", LookIn:=xlValues, LookAt:=xlWhole)
        If Not rng Is Nothing Then
            rng1 = rng.Address
            Do
                rng.EntireColumn.Hidden = True
                Set rng = .FindNext(rng)
            Loop While Not rng Is Nothing And rng.Address <> rng1
        End If
    End With
    Set rng = Nothing
End With
For i = 4 To 9
    With Sheets("Sheet" & i)
        .Rows("1:" & Rows.Count).Hidden = False
        With .Range("D:D")
            rng1 = rng.Address
            Set rng = .Find("0", LookIn:=xlValues, LookAt:=xlWhole)
            If Not rng Is Nothing Then
                Do
                    rng.EntireRow.Hidden = True
                    Set rng = .FindNext(rng)
                Loop While Not rng Is Nothing And rng.Address <> rng1
            End If
        End With
    End With
    Set rng = Nothing
Next i
Application.ScreenUpdating = True
End Sub
 
Upvote 0
That would be great, only I am not testing the entire column. Similar example: I have 10 oranges, 8 bananas, 29 kiwis, (etc.) and some apples. I am not sure how many apples I have until I count the rest of the fruit (I know, sounds strange).

That works wonders with my first sheet and has greatly increased the speed on it.

I might just have to suck it up and wait a few minutes. It beats going through manually and hiding the rows! :LOL:
 
Upvote 0
Try letting it complete running and see if it returns the desired result. If it does not, then I will adjust it so it looks at the specific ranges you defined.
 
Upvote 0
also rng1 is dim as string, yet it is not defined. It errs. I see how it would work, but does not make it all the way through. Works great on hiding columns for sheet 1, but cannot make it to the rows.
 
Upvote 0
Loop While Not rng Is Nothing And rng.Address <> rng1 in the second part of the code is where it is stuck
 
Upvote 0
I see. I had rng1 = rng.address in the wrong spot for sheets 4 through 9.

Try:

Code:
Public Sub Smoakstack()
Dim rng             As Range, _
    rng1            As String, _
    i               As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")
    .rows("1:" & rows.Count).Hidden = False
    With .Range("B9:B400")
        Set rng = .Find("0", LookIn:=xlValues, LookAt:=xlWhole)
        If Not rng Is Nothing Then
            rng1 = rng.Address
            Do
                rng.EntireRow.Hidden = True
                Set rng = .FindNext(rng)
            Loop While Not rng Is Nothing And rng.Address <> rng1
        End If
    End With
    Set rng = Nothing
End With
With Sheets("Sheet1")
    .rows("1:" & rows.Count).Hidden = False
    With .Range("M400:XX400")
        Set rng = .Find("0", LookIn:=xlValues, LookAt:=xlWhole)
        If Not rng Is Nothing Then
            rng1 = rng.Address
            Do
                rng.EntireColumn.Hidden = True
                Set rng = .FindNext(rng)
            Loop While Not rng Is Nothing And rng.Address <> rng1
        End If
    End With
    Set rng = Nothing
End With
For i = 4 To 9
    With Sheets("Sheet" & i)
        .rows("1:" & rows.Count).Hidden = False
        With .Range("D:D")
            Set rng = .Find("0", LookIn:=xlValues, LookAt:=xlWhole)
            If Not rng Is Nothing Then
                rng1 = rng.Address
                Do
                    rng.EntireRow.Hidden = True
                    Set rng = .FindNext(rng)
                Loop While Not rng Is Nothing And rng.Address <> rng1
            End If
        End With
    End With
    Set rng = Nothing
Next i
Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,649
Messages
6,120,730
Members
448,987
Latest member
marion_davis

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top