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?
 
With Sheet1
.Rows("1:" & Rows.Count).Hidden = False
With .Range("B9:B400")

Application or object defined errors
 
Upvote 0

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Sub Try1()

Application.ScreenUpdating = False
With Sheet1.Columns(1, "A:" & Columns.Count).Hidden = False
With Sheet1.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
End With

The part in red is getting stuck and will not go any further. I know it is a bit different than yours, but I am trying to work on it. It says application or object failure with each try.
 
Upvote 0
That is incorrect syntax. What specific line is erroring in the code I provided?
 
Upvote 0
Application.ScreenUpdating = False
With Sheet1.Rows("1:" & Rows.Count).Hidden = False
With Sheet1.Range("B9:B400")
Set rng = .Find("", 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

I had to change a few things. Looking for "" and not "0" for this one (text). the rest are "0".

What is in red is erroring
 
Upvote 0
Try the following. I tested the Find blocks of code on some dummy data, and found that when it is hiding rows, it cannot "find" that row again, so when it gets to the point where rng.address WOULD = rng1 (when it finishes looking through all of the data), it was returning an error for the rng.address.

Code:
Public Sub Smoakstack()
Dim rng             As Range, _
    i               As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")
    .rows("1:" & rows.Count).Hidden = False
    With .Range("B9:B400")
        Set rng = .Find("", 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
        End If
    End With
    Set rng = Nothing
End With
With Sheets("Sheet1")
    With .Range("M400:XX400")
        Set rng = .Find("0", LookIn:=xlValues, LookAt:=xlWhole)
        If Not rng Is Nothing Then
            Do
                rng.EntireColumn.Hidden = True
                Set rng = .FindNext(rng)
            Loop While Not rng Is Nothing
        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
                Do
                    rng.EntireRow.Hidden = True
                    Set rng = .FindNext(rng)
                Loop While Not rng Is Nothing
            End If
        End With
    End With
    Set rng = Nothing
Next i
Application.ScreenUpdating = True
End Sub
 
Upvote 0
That is gravy!

Now onto the rest of the pages. The thing is, I may or may not have quantities in Column D so I cannot check all of them. The code also does not work at

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
Do
rng.EntireRow.Hidden = True
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing
End If
End With
End With
Set rng = Nothing
Next i

SubScript out of Range.


Also read above about Column D
 
Upvote 0
I am working on an estimate, and sometimes if I use one material, I may or may not use another item, so I cannot hide everything in that column if it is a zero. I hope you follow me on that one. Certain materials require a certain way of installation, so ie: 1000 SF Shingles. Requires ice and water, felt, drip edge, and so forth. but if it were 1000 SF Metal roof, It requires ice and water, and foam, screws instead of nails, and so forth. Sometimes I get both shingles and metal so i have to have a spot for both. At times i could have upwards of 12 different materials for roof alone.
 
Upvote 0
The error might be because your sheets are named differently than what I programmed the code to do.

In an earlier post, you defined each range for the code to look at. Can you please tell me what "Sheet 4", "Sheet 5", "Sheet 6", etc are actually named in your workbook.

After getting the sheet names, I will work on re-coding the macro so that it will capture only specific areas of column D instead of the entire column.
 
Upvote 0
Sheet 4 = ACM Estimate
Sheet 5 = Foam Estimate
Sheet 6 = Single Skin Estimate
Sheet 7 = SSMR Estimate
Sheet 8 = Louver Estimate
Sheet 9 = Window Estimate
 
Upvote 0

Forum statistics

Threads
1,224,590
Messages
6,179,762
Members
452,940
Latest member
rootytrip

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