VBA Code Change

[Chris_010101]

Hello,

@Petertenthije kindly provided the below code for my absence tracker on 13 August 2022.

On the "current 12 months" tab, is held all absences within the current 12 month rolling period. The code will then activate upon opening the workbook and move any rows with an absence start date of less than 12 months from today to the "previous 12 months" tab. Then, on the "previous 12 months" tab, any rows with an absence start date of less than 24 months in the current 24-month rolling period are deleted.

• Current 12 months Tab - All absences in the latest 12 month rolling period
• Previous 12 months Tab - All absences in the previous 12 month rolling period

I now need this to change, so that it looks at:

• Current 6 months Tab - All absence in the last 6 month rolling period from the current day (based on absence start date)
• Previous 6 months Tab - All absence from 6 months to 12 months from the current day (based on absence start date)
• Previous 12 months Tab - All absence between 12 months and 24 months (based on absence start date)

Basically, when the workbook is opened, the code should move the rows between each tab, based on the absence start date and finally delete the row from "previous 12 months" once the absence start date is more than 24 months old from today.

The names and order of the columns will remain the same.

Hope this makes sense. @petertenthije original code is below:

Sub Workbook_Open()



' Set variables
    ' Move date
        Dim ToBeMovedDate As Long
        ToBeMovedDate = DateSerial(Year(Date) - 1, Month(Date), Day(Date))
    ' Delete date
        Dim ToBeDeletedDate As Long
        ToBeDeletedDate = DateSerial(Year(Date) - 2, Month(Date), Day(Date))
    ' Last row with data, current 12 months
        Dim LastRowCurrent12Months As String
        LastRowCurrent12Months = Sheets("Current 12 months").Cells(Sheets("Current 12 months").Rows.Count, "A").End(xlUp).Row
    ' Last row with data, previous 12 months
        Dim LastRowPrevious12Months As String
        LastRowPrevious12Months = Sheets("Previous 12 months").Cells(Sheets("Previous 12 months").Rows.Count, "A").End(xlUp).Row



' Remove existing filters , if applicable
    On Error Resume Next
        Sheets("Current 12 months").ShowAllData
        Sheets("Previous 12 months").ShowAllData
    On Error GoTo 0



'   o-------------------------------------------------------------o
'   |   MOVE LINES FROM CURRENT 12 MONTHS TO PREVIOUS 12 MONTHS   |
'   o-------------------------------------------------------------o

    ' Verify there are rows to be moved
        NumberOfRowsOnCurrent = WorksheetFunction.CountIfs(Sheets("Current 12 months").Range("J:J"), "<=" & ToBeMovedDate)

If NumberOfRowsOnCurrent > 0 Then
    ' Filter dates to be moved
        Sheets("Current 12 months").Range("A:N").AutoFilter Field:=10, Criteria1:="<=" & ToBeMovedDate
    ' Copy data to be moved to previous 12 months
        Sheets("Current 12 months").Select
        Sheets("Current 12 months").Range("A2:N" & LastRowCurrent12Months).Select
        Selection.Offset(0, 0).SpecialCells(xlCellTypeVisible).EntireRow.Copy
    ' Paste data into previous 12 months worksheet
        Sheets("Previous 12 months").Select
        Sheets("Previous 12 months").Range("A" & LastRowPrevious12Months + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    ' Remove copied data from current 12 months
        Sheets("Current 12 months").Select
        Sheets("Current 12 months").Range("A2:N" & LastRowCurrent12Months).Select
        Selection.Offset(0, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    ' Remove filter
        Sheets("Current 12 months").ShowAllData
End If



'   o-------------------------------------------------------------o
'   |            REMOVE LINES FROM PREVIOUS 12 MONTHS             |
'   o-------------------------------------------------------------o

    ' Verify there are rows to be removed
        NumberOfRowsOnPrevious = WorksheetFunction.CountIfs(Sheets("Previous 12 months").Range("J:J"), "<=" & ToBeDeletedDate)

If NumberOfRowsOnPrevious > 0 Then
    ' Filter dates to be deleted
        Sheets("Previous 12 months").Select
        Sheets("Previous 12 months").Range("A:N").AutoFilter Field:=10, Criteria1:="<=" & ToBeDeletedDate
    ' Select rows to be removed
        Sheets("Previous 12 months").Range("A2:N" & LastRowPrevious12Months).Select
    ' Delete rows
        Selection.Offset(0, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    ' Remove filter
        Sheets("PRevious 12 months").ShowAllData
End If



End Sub

 

[Chris_010101]

You're more than welcome Chris, glad we could help and thanks for the feedback. I'm 100% pro bono on this forum but thank you for the kind offer.

Hey, just a quick one.

I have a copy of the workbook, which has one difference, that another area of the business uses (I'm head office, the other is operations). The only difference is that Operations has an extra column, meaning the date is in column K, instead of column J.

I've given it a go myself on a copy of the data (as I often learn this way). I've tried changing where it says:

  .AutoFilter 10

to

  .AutoFilter 11

Based on my own logic that column J would be column 10 and column K would be column 11. But it's producing some weird results, like deleting some data that it shouldn't on the Previous 12 months sheet. So, I guess it's not as simple as altering that number?

I've bought the book written by the forum owner and I'm gunna learn how to write VBA, if it kills me!

Kind Regards
Chris

 

[kevin9999]

Hey, just a quick one.

I have a copy of the workbook, which has one difference, that another area of the business uses (I'm head office, the other is operations). The only difference is that Operations has an extra column, meaning the date is in column K, instead of column J.

I've given it a go myself on a copy of the data (as I often learn this way). I've tried changing where it says:

  .AutoFilter 10

to

  .AutoFilter 11

Based on my own logic that column J would be column 10 and column K would be column 11. But it's producing some weird results, like deleting some data that it shouldn't on the Previous 12 months sheet. So, I guess it's not as simple as altering that number?

I've bought the book written by the forum owner and I'm gunna learn how to write VBA, if it kills me!

Kind Regards
Chris

That's right Chris, the number refers to the column. I'd have no way of knowing why you're getting unexpected results without seeing your actual data.

 

[Chris_010101]

That's right Chris, the number refers to the column. I'd have no way of knowing why you're getting unexpected results without seeing your actual data.

Ok, so I've been playing around with it today and I realise why it might have been giving funny results.

I moved the extra column so the date the code references is back to column J, so I don't need to make any amendments to the code (as far as I'm aware).

I believe - and correct me if I'm wrong - there needs to be data in column A for the code to work? In my original testing, I was just adding the date in the column J and it wasn't moving the row but as soon as I added something like "5001" in column A, it worked.

 

[kevin9999]

Ok, so I've been playing around with it today and I realise why it might have been giving funny results.

I moved the extra column so the date the code references is back to column J, so I don't need to make any amendments to the code (as far as I'm aware).

I believe - and correct me if I'm wrong - there needs to be data in column A for the code to work? In my original testing, I was just adding the date in the column and it wasn't moving the row but as soon as I added something like "5001" in column A, it worked.

You're getting the hang of this Chris

 

[Chris_010101]

You're getting the hang of this Chris

Hope so!