Delete Rows Over 3 Months Old as of Today (VBA)

[C45P4R]

Hi all. I decided to start making macros at work for a few of our processes. I want to learn more about Excel. At the start of this project I had no VBA knowledge what-so-ever. I now have almost none . So far I've based a lot of the code from another macro and with the rest from Google searches and trial and error. Anyway, I'm stuck!

I need to delete all data which is over 2 months old from current date. I found a suggestion from another thread, but can't get it to work. To be honest, it's hard to work with because I don't really know what a lot of it means...

Sub
With Sheets("Booked")
LR = .Cells(Rows.Count, "AE").End(xlUp).Row
For i = LR To 2 Step -1
If .Cells(i, "AE").Value < DateAdd("m", -2, Date) Then
.Rows(i).EntireRow.Delete
End If
Next i
End With
End Sub

It seems to just cycle through the stages again and again without actually deleting anything.

I also need to label the data in a separate column based on the date relative to the day the macro is run. I can't find how to do this either. Any help would be much appreciated.

 

[C45P4R]

Firstly, thank you so much for your help.

In conclusion I don't think this is a practical way of doing what I want. When I used F8 to slowly cycle through the code, the row count did seem to be decreasing so I think it is working. Unfortunately, as there is a large number of rows in the spreadsheet and 7/9 of them will need deleting, it is taking far too long.

I think I will need code the spreadsheet to sort Z-A in column AE and subsequently delete any rows below the first column for which the date is over 2 months ago. Sort should be simple enough. No idea how to find the first date over 2months old and delete any rows below though.

 

[C45P4R]

I have just noticed the last line of your original post which if I understand correctly means that you wish to record, against the non-deleted rows, the date that you last ran the macro???

That isn't quite what I meant. I basically want to label one section of the data as "One Month Ago" and the other as "Two Months Ago". This is then used to easily segregate the two in some formula I have set up.

I think that the code was possibly working in the first place and I thought it wasn't because it got stuck on the cycle. I left it running in the background and it still isn't done. It has some 6000 rows to delete one at a time...

 

[NeonRedSharpie]

How long is too long? If you're worried about it taking too long, add in these additional codes:

Sub deleteRows()

    Dim maxRow As Long
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    




    With Sheets("Booked")
        maxRow = .Cells(Rows.Count, "AE").End(xlUp).row
             'This assumes your dates are in "AE"
        For x = maxRow To 2 Step -1
            If .Cells(x, "AE").Value < DateAdd("m", -2, Date) Then
                .Cells(x, "AE").Value = ""
            End If
        Next x
        
        .Range("AE2:AE" & maxRow).Select
        .Range("AE2").Activate
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.EntireRow.Delete
        
    End With
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = False
    
    Sheets("Booked").Range("AE2").Activate


End Sub

This will clear the cells, then delete them all at once. Should speed up your code a bazillion times over.

 

[C45P4R]

How long is too long? If you're worried about it taking too long, add in these additional codes:

This will clear the cells, then delete them all at once. Should speed up your code a bazillion times over.

Thanks, I'll give it a go. I don't know how long too long is because it never finished. I waited at least 10mins to see what was happening before giving up.

 

[C45P4R]

How long is too long? If you're worried about it taking too long, add in these additional codes:

Sub deleteRows()

    Dim maxRow As Long
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    




    With Sheets("Booked")
        maxRow = .Cells(Rows.Count, "AE").End(xlUp).row
             'This assumes your dates are in "AE"
        For x = maxRow To 2 Step -1
            If .Cells(x, "AE").Value < DateAdd("m", -2, Date) Then
                .Cells(x, "AE").Value = ""
            End If
        Next x
        
        .Range("AE2:AE" & maxRow).Select
        .Range("AE2").Activate
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.EntireRow.Delete
        
    End With
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = False
    
    Sheets("Booked").Range("AE2").Activate


End Sub

This will clear the cells, then delete them all at once. Should speed up your code a bazillion times over.

You absolute legend. Works like a charm. Wish I could understand more of it. I guess with time it'll come.

Thanks for all the input. Such a helpful and active community here, it's great.

 

[NeonRedSharpie]

You absolute legend. Works like a charm. Wish I could understand more of it. I guess with time it'll come.

Thanks for all the input. Such a helpful and active community here, it's great.

Well let me comment it out for you:

Sub deleteRows()

    Dim maxRow As Long
    
    ' Turn off screenupdating so excel won't...update the screen
    Application.ScreenUpdating = False
    ' Turn off events so nothing gets triggered and causes loops
    Application.EnableEvents = False
    ' Turn calcs to manual so excel stop calculating everything on change
    Application.Calculation = xlCalculationManual


    ' Make sure eveything that happens is in the BOOKED sheet.
    ' Use periods in front of a line to indicate the BOOKED sheet.
    With Sheets("Booked")
    
        ' Find the last populated cell in the column
        maxRow = .Cells(Rows.Count, "AE").End(xlUp).row
             'This assumes your dates are in "AE"
        
        ' Loop through the cells in the column
        For x = maxRow To 2 Step -1
            ' If the cell is less than two months before today's date then...
            ' You can use "y" for year, "d" for day, etc...
            If .Cells(x, "AE").Value < DateAdd("m", -2, Date) Then
                ' Replace the date cell with a blank (see later why)
                .Cells(x, "AE").Value = ""
            End If
        Next x
        
        ' Select the range we just looped through
        .Range("AE2:AE" & maxRow).Select
        ' Activate the top cell (actually this is useless but shhhhhhh)
        .Range("AE2").Activate
        ' This next part is the same as hitting F5>Special and selecting "Blank"
        Selection.SpecialCells(xlCellTypeBlanks).Select
        ' Delete the selected cells and the accompanying rows.
        Selection.EntireRow.Delete
        
    End With
    
    'Turn on all that stuff we turned off earlier...
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = False
    
    ' Select the top cell so you aren't looking at highlighted
    ' cells from AE2 to AE5478
    Sheets("Booked").Range("AE2").Activate


End Sub

I think I might comment all my code from now on for here. I know I always hated seeing code without comments....I've become the problem!

 

[Snakehips]

Does this mod give you the labelling you require? Again column AG as an example.

Sub deleteRows()


    Dim maxRow As Long
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual




    With Sheets("Booked")
        maxRow = .Cells(Rows.Count, "AE").End(xlUp).Row
             'This assumes your dates are in "AE"
        For x = maxRow To 2 Step -1
        
            If .Cells(x, "AE").Value < DateAdd("m", -2, Date) Then
                .Cells(x, "AE").Value = ""
            ElseIf .Cells(x, "AE").Value < DateAdd("m", -1, Date) Then
                .Cells(x, "AG").Value = "Two Months Ago"    '**************  Edit AG ?
            Else
                .Cells(x, "AG").Value = "One Month Ago"      '**************  Edit AG ?
            End If
        Next x
        
        .Range("AE2:AE" & maxRow).Select
        .Range("AE2").Activate
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.EntireRow.Delete
        
    End With
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = False
    
    Sheets("Booked").Range("AE2").Activate




End Sub

 

[C45P4R]

Thanks Snake and Neon, you've both been a great help. I had a crack at the code for labeling before cheating and using Snakes method. My method didn't work. I have a theory why... Could enlighten me? Snake's method is much nicer, I just want to know whats wrong for educational purposes.

What ends up happening is that anything 2 months old is labeled as current and anything between one and 2 months gets left blank. I thought it would label everything as prior and subsequently over-write the 1 month old with current.

Typing it out and seeing your code has helped... I was looking at the less than part of the code incorrectly. If I was to use this method. Presumably I would need to change the line for "Current" to ("m", 0, Date) and have it followed by the "Prior" to overwrite some of that data with ("m",1,Date)? Yes, I am aware it's sloppy...

Sub Labeling()

With Sheets("Booked")
        maxRow = .Cells(Rows.Count, "AE").End(xlUp).Row
        For x = maxRow To 2 Step -1
            If .Cells(x, "AE").Value < DateAdd("m", -2, Date) Then
                .Cells(x, "AF").Value = "Prior"
                    End If
            If .Cells(x, "AE").Value < DateAdd("m", -1, Date) Then
                .Cells(x, "AF").Value = "Current"
                    End If
          Next x
    End With
 
End Sub

 

[C45P4R]

Also, in relation to the comment by Neon on part of his code:

Application.EnableEvents = False ' Turn calcs to manual so excel stop calculating everything on change

I have a sheet with lots of formula that pulls data from other sheets etc. Should I just be turning calculations off for the entire macro process and switch them back on right at the end? Would it make much of a difference to the time it takes the macro to run its course? Every time a sheet is changed, it will cause changes in the first sheet.

 

[C45P4R]

One more thing... What where the key resources you guys used when learning how to code VBA? Obviously doing projects is a great way to learn, but sometimes I need a resource to help me code. I don't want to ask here every 5 minutes and Google searches can be frustrating in some instances.