VBA - Clear all rows below if

[nitrammada]

Hi Everyone,
I have a macro that clears the row from columns C to P if the cell in column C = 0.
Once the cell in column C is found to contain 0, everything below (including that row) can be cleared in columns C to P.
The macro works but it takes such a long time eg 30 seconds to clear 1500 rows.
Is there a quicker way to do this? Below is what I have already.

Sub ClearErrors()
    'This is for sheet "Print3" to remove the #N/A at bottom of report
Application.ScreenUpdating = False
Application.EnableEvents = False

    Dim Count, i As Long
    Count = ActiveSheet.Cells(Rows.Count, "j").End(xlUp).Row
    'MsgBox count
    i = 8
        Do While i <= Count
            If Cells(i, 3) = 0 Then
                Rows(i).EntireRow.ClearContents
                'Range(Cells(i, 3), Cells(i, 16)) = ""
            End If
        i = i + 1
        Loop
        
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

I have had a look on the forum questions (a big thanks for all those that contribute) but most solutions use the 'Loop' function and it takes ages to clear.
Any suggestions would be most welcome, or perhaps I have something in my code that is slowing it down.
Thanks in advance
Adam

 

[Michael M]

Post #4 was mine, so I'm a bit confused, but Check my last post, #9?
AND
I think this will fix the issue in the post from @offthelip

Sub ClearErrors()
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
    Dim Count, i As Long
    Count = ActiveSheet.Cells(Rows.Count, "j").End(xlUp).Row
    inarr = Range(Cells(1, 3), Cells(Count, 3))
    i = 8
        Do While i <= Count
            If inarr(i, 1) = 0 Then
                Range(Cells(i, 3), Cells(i, 16)) = ""
            End If
        i = i + 1
        Loop
With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

 

[nitrammada]

Slight change

Sub MM1()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "C").End(xlUp).Row
Application.ScreenUpdating = False
    For r = 1 To lr
        If Cells(r, 3) = 0 Then Range(Cells(r + 1, 3), Cells(lr, 16)).Clear
    Next r
Application.ScreenUpdating = True
End Sub

The code provided clears columns C to P, 1 row after the found "0" through to the last row. Isn't that what you needed ??

Yes, that's correct. however, it clears everything even rows where a cell in column C has a legitimate number. Would it be that I have a formula in column C that is referencing a query?

 

[Michael M]

In Post #8 you said

Is it possible to adjust your code so that if a zero is found in column C then clear from that point down everthing that is in columns C to P?

You may need to be more specific in your reuest

 

[nitrammada]

Post #4 was mine, so I'm a bit confused, but Check my last post, #9?
AND
I think this will fix the issue in the post from @offthelip

Sub ClearErrors()
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
    Dim Count, i As Long
    Count = ActiveSheet.Cells(Rows.Count, "j").End(xlUp).Row
    inarr = Range(Cells(1, 3), Cells(Count, 3))
    i = 8
        Do While i <= Count
            If inarr(i, 1) = 0 Then
                Range(Cells(i, 3), Cells(i, 16)) = ""
            End If
        i = i + 1
        Loop
With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

Sorry Michael, my bad, I can't count. Apologies for the confusion. Thanks for fixing the above, it works now but still takes about 30-40 seconds to clear about 1400 rows of unwanted data. Is that normal, perhaps I'm expecting too much?

 

[Michael M]

My code took 2.44 seconds
Maybe you could upload the worksheet to Dropbox or similar hosting site then post the link back here, and we can see why it takes so long.

Sub MM1()
Dim lr As Long, r As Long, t1 As Double, t2 As Double
t1 = Timer
lr = Cells(Rows.Count, "C").End(xlUp).Row
Application.ScreenUpdating = False
    For r = 1 To lr
        If Cells(r, 3) = 0 Then Range(Cells(r + 1, 3), Cells(lr, 16)).ClearContents
    Next r
Application.ScreenUpdating = True
t2 = Timer
MsgBox t2 - t1
End Sub

 

[nitrammada]

My code took 2.44 seconds
Maybe you could upload the worksheet to Dropbox or similar hosting site then post the link back here, and we can see why it takes so long.

Sub MM1()
Dim lr As Long, r As Long, t1 As Double, t2 As Double
t1 = Timer
lr = Cells(Rows.Count, "C").End(xlUp).Row
Application.ScreenUpdating = False
    For r = 1 To lr
        If Cells(r, 3) = 0 Then Range(Cells(r + 1, 3), Cells(lr, 16)).ClearContents
    Next r
Application.ScreenUpdating = True
t2 = Timer
MsgBox t2 - t1
End Sub

Hmmm, I'm perplexed Michael, I ran your code, it took 45 seconds and cleared everything from row 2 down. I do appreciate your time helping me with this Michael. As per your suggestion, below is a link to dropbox that contains the xlsm file with the data in it.

102SOEMT2.xlsm

Shared with Dropbox

www.dropbox.com

Ignore the customization errors that come up as it is looking for custom written software that you will not have on your machine.
The report with the data can be found on the tab called 'Print3'. You will see there are 1095 rows of data that I need in the report.
At the top of the page are 4 buttons that run macros, its the 1st button that runs the macro Sub ResetAllData(). This is a simple copy and paste of row 10 to rows 11 to 2500. The reports vary in size but generally speaking 2500 rows is enough. The source of the data comes from Query3, the amount of date here will vary from job to job. Ideally it would be good only to reference the number of rows contained in Query3 but I don't know how, so copy to 2500 rows is my work around.

In this instance it generates 1095 lines of data for the report. Now I want to run code the clears rows 1096 through to row 2500, this is where I have difficulty, the code I have works but as mentioned earlier, it takes a while to clear rows 1096 to 2500.
I hope the dropbox link works ok for you and that I have provided enough detail for you.
Thanks again.

 

[Michael M]

Looks like your doing your own version of the "Benchmark" software.
I think it's running slow, because somewhere in all of your sheets / modules there are worksheet_change events and / or recalculate evnts reacting every time a row is cleared.
That's where I'd look first.
I used to b a senior estimator for the govt and had my own version of estimating templates as well as Benchmark....Do they still do probability calcs in estimating ??

 

[nitrammada]

Looks like your doing your own version of the "Benchmark" software.
I think it's running slow, because somewhere in all of your sheets / modules there are worksheet_change events and / or recalculate evnts reacting every time a row is cleared.
That's where I'd look first.
I used to b a senior estimator for the govt and had my own version of estimating templates as well as Benchmark....Do they still do probability calcs in estimating ??

Huh, small world, hey. So you would understand exactly what I'm trying to achieve here right? Yes, we still run a risk profile over certain projects and do a risk analysis on parts of the project if that's what you mean. Depends what the client wants really.

Thanks so much for looking at this, you're right i do have a change event happening over the entire workbook which is a pain actually as I only want it to run on certain sheets not the entire workbook.
I'll disable and run the code and see what happens as you suggested. Did your code work on the example I sent you?

 

[Michael M]

Try this then, it only made a few seconds difference for me....but...

Sub MM1()
Dim lr As Long, r As Long, t1 As Double, t2 As Double
t1 = Timer
lr = Cells(Rows.Count, "C").End(xlUp).Row
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
    For r = 8 To lr
        If Cells(r, 3) = 0 Then Range(Cells(r + 1, 3), Cells(lr, 16)).ClearContents
    Next r
With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
t2 = Timer
MsgBox t2 - t1 & " seconds to run !!"
End Sub

If it works, ALL kudos go to @Alex Blakenburg

 

[offthelip]

Hello Offthelip,
Thanks again for your assistance, I get a compile error message 'Exit For not within For....Next' Any thoughts what this might be?
Kind regards

Sorry that should be an

exit do