Delete entirerow if cellvalue in column A has "xxxx" as year

[Eyeson15]

Please take me out of my misery.
I think I'm going insane from google search overload.

I have a workbook with 5000+ entries. It has dates in the format (dd.mm.yy) in Column A.

All I need to do is delete ALL the rows that are not between 2005 and 2010 (inclusive both years)

For example:

(1) 22.02.14
(2) 01.01.07
(3) 02.12.01

So, Rows 1 and 3 would be deleted and 01.01.07 is kept because it is between 2005 and 2010.

Please help me, I got over 6 workbooks to do this and really can't do this manually.

Below is the code I sort of made. Doesn't work ofcourse but brilliant code for crashing computers.

James

Sub DeleteRows()
    
    Dim i As Long
    Dim st As Long
    Dim en As Long
    Dim test As Long

    'Set ranges to four digit year code'
    st = 2005
    en = 2010

    For i = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    
    test = Val(WorksheetFunction.Text(ActiveSheet.Range("A" & i).Value, "yyyy"))
    If test < st Or test > en Then
    ActiveSheet.Range("A" & i).EntireRow.Delete
    End If
    Next i
    
End Sub

 

[Eyeson15]

you guys are truly inspirational. i hope to be an efficient coder one day. thank you all for the hard work

James

 

[AkaTrouble]

if someone would like to post a workbook with the test data and macros i am happy to run test to see outcome on my machine running win 10 excel 2016 (32 bit)

 

[Tetra201]

... that is a big discrepancy... I wonder what is at the heart of it?

No clue at the moment.

And the Application.Union seems to be able to digest 497,000+ calls without any problems.

 

[Rick Rothstein]

And the Application.Union seems to be able to digest 497,000+ calls without any problems.

The problem with using Union is not that it cannot handle a large amount of calls, rather I have been led to believe (in the distant past, back in my compiled VB volunteer days) that each time Union is called, it needs to find a new chunk of continuous memory and copy its contents plus the new range into that new memory chunk... as the Union grows larger, finding the new continuous memory chunks becomes harder meaning the system's underlying "garbage collection" routines need to be employed over and over again in order to accommodate the larger and larger Unions.

 

[Tetra201]

if someone would like to post a workbook with the test data and macros i am happy to run test to see outcome on my machine running win 10 excel 2016 (32 bit)

Thank you AkaTrouble, that would be really interesting.

My exact setup is described in Posts #26 and #29.

Here is a sub that I used to populate the dataset:

Sub Pop500K()
    Range("A1") = #1/1/1910#
    Range("A2:A500000").FormulaR1C1 = "=R[-1]C+1"
    Columns("A:A").Copy
    Columns("A:A").PasteSpecial Paste:=xlPasteValues
    Columns("A:A").NumberFormat = "dd.mm.yyyy"
    Range("B1:B500000") = 1
    Range("C1:C500000") = 2
    Range("D1:D500000") = 3
    Range("E1:E500000") = 4
    Range("F1:F500000") = 5
End Sub

 

[AkaTrouble]

ok i ran macro to create data sheet

for Tetra201 timer returned 9.178

for Rick 2.742

for Peter 4.352

 

[Tetra201]

ok i ran macro to create data sheet

for Tetra201 timer returned 9.178

for Rick 2.742

for Peter 4.352

Thank you again.

That's very close to what I posted in #29, and the order is the same.

 

[Rick Rothstein]

if someone would like to post a workbook with the test data and macros i am happy to run test to see outcome on my machine running win 10 excel 2016 (32 bit)

Here is a link to a workbook containing the 500,000 rows of data that I used in developing my code...

https://dl.dropboxusercontent.com/u/48365047/FiveHundredThousandRecords.xlsx

 

[Peter_SSs]

Here is a sub that I used to populate the dataset:

Sub Pop500K()
    Range("A1") = #1/1/1910#
    Range("A2:A500000").FormulaR1C1 = "=R[-1]C+1"
    Columns("A:A").Copy
    Columns("A:A").PasteSpecial Paste:=xlPasteValues
    Columns("A:A").NumberFormat = "dd.mm.yyyy"
    Range("B1:B500000") = 1
    Range("C1:C500000") = 2
    Range("D1:D500000") = 3
    Range("E1:E500000") = 4
    Range("F1:F500000") = 5
End Sub

Your dates are sequential, meaning that there are at most two contiguous blocks of rows to delete. That will produce very different results to a set of random dates. I don't really know what the OP's data is like, but the small sample in post #1 makes me think we are not dealing with a set of sequential dates.

Try this instead.
Format column A as Date then run this code, make copies of the sheet & try the various suggested codes on the result.

Sub RandomDataSet()
    Dim a
    Dim r As Long, c As Long
    
    Const rws As Long = 500000
    Const cols As Long = 6
    Const MaxNum As Long = 7000
    Const TopLeftCell As String = "A2"
    
    ReDim a(1 To rws, 1 To cols)
    For r = 1 To rws
        For c = 1 To cols
            a(r, c) = 36000 + Int(Rnd() * MaxNum)
        Next c
    Next r
    Range(TopLeftCell).Resize(rws, cols).Value = a
End Sub

 

[AkaTrouble]

Here is a link to a workbook containing the 500,000 rows of data that I used in developing my code...

https://dl.dropboxusercontent.com/u/48365047/FiveHundredThousandRecords.xlsx

for Tetra201 debugs to this line

 If (Year(cll.Value) < st) Or (Year(cll.Value) > en) Then

if i remove header row it just crashes excel


for Rick 50.414

for Peter 4.289