Excel VBA Loop Question

[darin100K]

I need help constructing part of a macro that searches through each row in column A, spreadsheet "Calc", excluding Row 1, and deletes all rows where date in column A is less than todays date. The number of rows varies and it is critical that this loop excludes row 1.

Thank You!

 

[pgc01]

Hi darin100K

Please try the following code:

Sub DelBefToday()
    
With Worksheets("Calc")
    .AutoFilterMode = False
    .Columns("A").AutoFilter Field:=1, Criteria1:="<" & Date
    .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row) _
                           .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
End With
End Sub

Hope this solves your problem
PGC

 

[darin100K]

I'm getting an error "Application-defined or object-defined error" and .Columns("A").AutoFilter Field:=1, Criterial:="<" & Date highlights in yellow. Is there anyway you could either help me troubleshoot this or just give me a way to do this without using autofilter? I forgot to mention that I have already sorted by date.

Thanks again!

 

[pgc01]

Hi again

I don't see why you get the error. I've just tried and it worked.

However, I',m posting another code that does the same thing, although much less efficiently. I've just tried this one also.

Hope it works
PGC

Sub DelBefToday()
Dim lRowMax As Long, lRow As Long

Application.ScreenUpdating = False
With Worksheets("Calc")
    lRowMax = .Range("A" & .Rows.Count).End(xlUp).Row
    For lRow = lRowMax To 2 Step -1
        If .Range("A" & lRow).Value < Date Then .Rows(lRow).Delete
    Next
End With
Application.ScreenUpdating = True
End Sub

 

[HalfAce]

Hello darin100K,
pgc01's filter code worked well for me too and is definitely the way to go providing you
have less than, I think about 9200 (or 9700?) rows. (Limit to the SpecialCells function.)

However if you're going to loop through the column then this should be a bit quicker.
It just looks for first instance of the current date (from the bottom up) and deletes all
the rows below that in one quick shot.

Sub DelBefToday()
Dim lRowMax As Long, lRow As Long
Application.ScreenUpdating = False
With Worksheets("Calc")
    .Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlDescending
    lRowMax = .Range("A" & .Rows.Count).End(xlUp).Row
    For lRow = lRowMax To 2 Step -1
        If .Range("A" & lRow).Value = Date Then
            Range(Cells(lRow + 1, "A"), Cells(lRowMax, "A")).EntireRow.Delete
            Exit For
        End If
     Next
     ''//Un-comment the next line if you want the dates sorted in Ascending order
     '.Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending
End With
Application.ScreenUpdating = True
End Sub

 

[pgc01]

Hi HalfAce

Thanks for stepping in and posting your more efficient code.

I got curious about the "Limit to the SpecialCells function". Since SpecialCells returns a range, I know the general range limitation of a maximum of 8192 non contiguous cells. But I didn't know that for SpecialCells there is a special limitation. Since in this case the data was already sorted, the cells would be contiguous and I thought there would be no problem. Apparently I was wrong (again).
Could you please tell me where I can find detailed information about the SpecialCells limitation?

Thanks
PGC

 

[HalfAce]

Hello PGC,
There may well not be any problem with what you posted. I would certainly prefer to use
specialcells over looping. (I just don't always remember to do it.)

Since in this case the data was already sorted, the cells would be contiguous and I thought there would be no problem. Apparently I was wrong (again).
Could you please tell me where I can find detailed information about the SpecialCells limitation?

You may well be right in the difference being contiguous vs non-contiguous specialcells.
(And you're right about the number being 8192.)
I only know it's been pointed out to me in the past with code I've written but never really
paid much attention to the contiguous/non-contiguous aspect.

Here are a couple of links to info concerning the subject.
I haven't the time to read through them at the moment (work getting in the way of
life again :x )
so I don't know if they'll tell you anything you don't already know.

(Board discussion...)
http://www.mrexcel.com/board2/viewtopic.php?t=74180

Ozgrid
http://www.ozgrid.com/VBA/VBALoops.htm

MS site
http://support.microsoft.com/default.aspx?scid=kb;en-us;832293&Product=xlw2K

 

[pgc01]

Hi HalfAce

Thank you for the information you posted. I will surely look into it.

Cheers
PGC