Auto deleting in excel

[PlumGr8]

So, i got some great help a couple years ago in getting a VB Macro to run to delete days within an excel sheet that were X amount of days old. It was also setup to count and add certain even together. So i am working on using that VB for another sheet and am try to modify it to work and having an issue. In the original one column A had a standard date 20220101 and it would look for dates older than they and delete. No when they do it, they will merger the entire row columns A-L and enter the date as "Monday, January 3, 2022". Does the VB have to be adjusted to see the date that way? Also, in the original VB i was tracking trucks going from "Site 1", "site 2" etc, so as it would delete it would add to another cell to keep track of the total as well, but not in this sheet they use arrows "↑" and "↓". Does VB recognize using those arrows?

Here is a copy of the VB i had entered for now, this is definitely above me, so trying to make it work so can use any help thanks.

Private Sub Workbook_Open()

Sheets("Delivery").Unprotect

DaysOld = 75

CheckRow = 4 'This is the first row to check - it assumes that rows 1-2-3 are headers

RecordsFound = 0 'This is a counter of the number of rows deleted

Application.EnableEvents = False

Application.ScreenUpdating = False

With Sheets("Delivery")

Do 'Go through records, if the record is old enough to delete then delete.

'Stop when column A is blank

If .Range("A" & CheckRow).Value = "" Then Exit Do

If .Range("A" & CheckRow).Value < (Now - DaysOld) Then

'This record needs to be deleted - check if it contains any Job Sites and update the totals

If .Range("E" & CheckRow).Value = "↑" Then .Range("AA5").Value = .Range("AA5").Value + 1

If .Range("E" & CheckRow).Value = "↓" Then .Range("AF5").Value = .Range("AF5").Value + 1



'Then delete the record

.Range("A" & CheckRow & ":M" & CheckRow).Delete (xlShiftUp)

RecordsFound = RecordsFound + 1

Else

CheckRow = CheckRow + 1

End If

Loop

End With

Application.ScreenUpdating = True

Application.EnableEvents = True

Sheets("Delivery").Protect



End Sub

 

[Trevor_S]

Sounds like a good plan. I always think that inserting/deleting entire rows is "tidier" than just column ranges. You could set it to just hold the up and down tracking on the admin page, or (if you still want them on the data page) could you put them somewhere in rows 1:3 - i.e. above the rows that will be deleted?

Assuming that you do just use the admin sheet, and the up and down tracking is in Z1 and Z2 (amend to the actual cell references!), the shortest version of the code (i.e. without the loops) would be:

Private Sub Workbook_Open()
Sheets("Truck Data").Unprotect
RowsOld = Sheets("Admin").Range("J5").Value
StartRow = 4 'This is the first row of data - it assumes that rows 1-2-3 are headers
Application.EnableEvents = False
Application.ScreenUpdating = False
With Sheets("Truck Data")
  'Count arrows in range to be deleted and add to the relevant cell
  Arrow1 = Application.WorksheetFunction.Countif(.Range("E" & StartRow & ":E" & StartRow + RowsOld - 1), ChrW(2191))
  Sheets("Admin").Range("Z1").Value = Sheets("Admin").Range("Z1").Value + Arrow1
  Arrow2 = Application.WorksheetFunction.Countif(.Range("E" & StartRow & ":E" & StartRow + RowsOld - 1), ChrW(2193))
  Sheets("Admin").Range("Z2").Value = Sheets("Admin").Range("Z2").Value + Arrow2
  'Then delete the records
  .Range("A" & StartRow & ":A" & StartRow + RowsOld - 1).EntireRow.Delete
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
Sheets("Truck Data").Protect
End Sub

 

[PlumGr8]

Sounds like a good plan. I always think that inserting/deleting entire rows is "tidier" than just column ranges. You could set it to just hold the up and down tracking on the admin page, or (if you still want them on the data page) could you put them somewhere in rows 1:3 - i.e. above the rows that will be deleted?

Assuming that you do just use the admin sheet, and the up and down tracking is in Z1 and Z2 (amend to the actual cell references!), the shortest version of the code (i.e. without the loops) would be:

Private Sub Workbook_Open()
Sheets("Truck Data").Unprotect
RowsOld = Sheets("Admin").Range("J5").Value
StartRow = 4 'This is the first row of data - it assumes that rows 1-2-3 are headers
Application.EnableEvents = False
Application.ScreenUpdating = False
With Sheets("Truck Data")
  'Count arrows in range to be deleted and add to the relevant cell
  Arrow1 = Application.WorksheetFunction.Countif(.Range("E" & StartRow & ":E" & StartRow + RowsOld - 1), ChrW(2191))
  Sheets("Admin").Range("Z1").Value = Sheets("Admin").Range("Z1").Value + Arrow1
  Arrow2 = Application.WorksheetFunction.Countif(.Range("E" & StartRow & ":E" & StartRow + RowsOld - 1), ChrW(2193))
  Sheets("Admin").Range("Z2").Value = Sheets("Admin").Range("Z2").Value + Arrow2
  'Then delete the records
  .Range("A" & StartRow & ":A" & StartRow + RowsOld - 1).EntireRow.Delete
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
Sheets("Truck Data").Protect
End Sub

Ok, so some progress. It doesn't freeze, but it seems to be deleting everything? I entered information on line 4 through 25, with the value set at 250, open up the file and it deletes all the data in the sheet.

 

[Trevor_S]

That would be right? RowsOld taken from J5 of the admin sheet is the number of rows being deleted. So if that's set as 250, the macro should delete lines 4 to 253.

Or was the 250 the number of rows you wanted left after deletion?

 

[PlumGr8]

Ok, I see what you mean about the rows, and how its deleting, but not that has me thinking. So like the original macro the dates progress down from the top. I thought it may be easier doing by rows, but say I want it to be limited to 250, I was tryin to get it to say ok I need to be at 250, there is information down to row 270, I need to delete the top 20 lines and shift everything up. Just basically deleting the first X amount of rows to maintain the 250 mark. Unless there's a way to make it look by the date in that merged line? I can get them to type it in a format of "Thursday, January 27, 2022". Just not sure which way is the best.

Appreciate all the help, definitely helping me with learning new things. You've been awesome.

 

[PlumGr8]

That would be right? RowsOld taken from J5 of the admin sheet is the number of rows being deleted. So if that's set as 250, the macro should delete lines 4 to 253.

Or was the 250 the number of rows you wanted left after deletion?

I did just try the dates instead of the row, even if I format the merged row into a specific date format like I mentioned above, it seems to just delete everything, so thinking the row idea will be best?

 

[Trevor_S]

Deletion to leave a set number of rows

Here's an amended macro so that it leaves undeleted the number of rows specified in J5 of the admin sheet, rather than deleting that many rows. I've changed the variable name from RowsOld to RowsLeft (to make it clearer as to what it is), and created a new variable for the row number to delete down to (DeleteTo). This is calculated as the row number of the last row, minus the value of RowsLeft. There is then a check to make sure that DeleteTo is at least as high as the start row, as if it is not, there is no deletion required.

Note - it determines the last row by starting in cell A4 and going to the end - this is the macro equivalent of pressing End then the down arrow on the keyboard. If there are any blank cells in column A, it will treat the last row before the blank cell as the end, so won't delete as many rows as expected. Also you must have at least two rows of data, otherwise the .End(xlDown) would go right to the bottom of the Excel sheet, likely to be row 1,048,576 unless you're using a very old version of Excel.

Private Sub Workbook_Open()
Sheets("Truck Data").Unprotect
RowsLeft = Sheets("Admin").Range("J5").Value
StartRow = 4 'This is the first row of data - it assumes that rows 1-2-3 are headers
With Sheets("Truck Data")
  DeleteTo = .Range("A" & StartRow).End(xlDown).Row - RowsLeft
  If DeleteTo < StartRow Then End 'Stop the macro here as there are no rows to delete
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  'Count arrows in range to be deleted and add to the relevant cell
  Arrow1 = Application.WorksheetFunction.Countif(.Range("E" & StartRow & ":E" & DeleteTo), ChrW(2191))
  Sheets("Admin").Range("Z1").Value = Sheets("Admin").Range("Z1").Value + Arrow1
  Arrow2 = Application.WorksheetFunction.Countif(.Range("E" & StartRow & ":E" & DeleteTo), ChrW(2193))
  Sheets("Admin").Range("Z2").Value = Sheets("Admin").Range("Z2").Value + Arrow2
  'Then delete the records
  .Range("A" & StartRow & ":A" & DeleteTo).EntireRow.Delete
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
Sheets("Truck Data").Protect
End Sub

Deleting older than a set date / number of days

As in earlier posts, this is only possible if Excel recognises what has been entered into the merged cells as a date, rather than it just being some text which the users recognise as a date. The reason for this is that the macro would need to check whether the date in the cell is older than a calculated date (rather than just looking for an exact match), as there may be some dates (weekends/public holidays?) where there are no records.

The only way to test this is to select one of the merged cells, right-click and select Format Cells. On the Number Tab, under Category pick Date. Then under Type on the right, pick one of the options for a different format to that currently in use, then Ok. If the date in the spreadsheet is now displayed in the new format, then Excel has recognised it as a date and we can do a macro that deletes on this basis. However if the format remains unchanged, then Excel just thinks that it is text, so we can't do a macro that checks the date.

 

[PlumGr8]

Deletion to leave a set number of rows

Here's an amended macro so that it leaves undeleted the number of rows specified in J5 of the admin sheet, rather than deleting that many rows. I've changed the variable name from RowsOld to RowsLeft (to make it clearer as to what it is), and created a new variable for the row number to delete down to (DeleteTo). This is calculated as the row number of the last row, minus the value of RowsLeft. There is then a check to make sure that DeleteTo is at least as high as the start row, as if it is not, there is no deletion required.

Note - it determines the last row by starting in cell A4 and going to the end - this is the macro equivalent of pressing End then the down arrow on the keyboard. If there are any blank cells in column A, it will treat the last row before the blank cell as the end, so won't delete as many rows as expected. Also you must have at least two rows of data, otherwise the .End(xlDown) would go right to the bottom of the Excel sheet, likely to be row 1,048,576 unless you're using a very old version of Excel.

Private Sub Workbook_Open()
Sheets("Truck Data").Unprotect
RowsLeft = Sheets("Admin").Range("J5").Value
StartRow = 4 'This is the first row of data - it assumes that rows 1-2-3 are headers
With Sheets("Truck Data")
  DeleteTo = .Range("A" & StartRow).End(xlDown).Row - RowsLeft
  If DeleteTo < StartRow Then End 'Stop the macro here as there are no rows to delete
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  'Count arrows in range to be deleted and add to the relevant cell
  Arrow1 = Application.WorksheetFunction.Countif(.Range("E" & StartRow & ":E" & DeleteTo), ChrW(2191))
  Sheets("Admin").Range("Z1").Value = Sheets("Admin").Range("Z1").Value + Arrow1
  Arrow2 = Application.WorksheetFunction.Countif(.Range("E" & StartRow & ":E" & DeleteTo), ChrW(2193))
  Sheets("Admin").Range("Z2").Value = Sheets("Admin").Range("Z2").Value + Arrow2
  'Then delete the records
  .Range("A" & StartRow & ":A" & DeleteTo).EntireRow.Delete
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
Sheets("Truck Data").Protect
End Sub

Deleting older than a set date / number of days

As in earlier posts, this is only possible if Excel recognises what has been entered into the merged cells as a date, rather than it just being some text which the users recognise as a date. The reason for this is that the macro would need to check whether the date in the cell is older than a calculated date (rather than just looking for an exact match), as there may be some dates (weekends/public holidays?) where there are no records.

The only way to test this is to select one of the merged cells, right-click and select Format Cells. On the Number Tab, under Category pick Date. Then under Type on the right, pick one of the options for a different format to that currently in use, then Ok. If the date in the spreadsheet is now displayed in the new format, then Excel has recognised it as a date and we can do a macro that deletes on this basis. However if the format remains unchanged, then Excel just thinks that it is text, so we can't do a macro that checks the date.

Awesome, that works perfect with the auto deleting. Only thing now is the arrow counting. I had set it up like I did on the previous macro, so on the admin page, I have 3 charts. One showing the coming and going, one that shows those 2 as a combined total, and one listed as "macro". Those total are in AC5 & AC7. So, the totals in and out are what it see in Column E + the deleted ones from AC5. But those are just populating with 0's?

 

[Trevor_S]

Two possibilities on the arrow counting. I didn't know where you wanted the counts put, so my code just refers to Z1 and Z2. Have you changed these to the correct references?

If you have, then it sounds like it isn't recognising the character numbers. So it does the check, finds nothing that it thinks matches and adds zero to both figures. If that's the case, could you get the characters from the admin sheet? From your screen shot they appear to be two cells to the left of the count, so AA5 and AA7? That section of code would then become:

  'Count arrows in range to be deleted and add to the relevant cell
  Arrow1 = Application.WorksheetFunction.Countif(.Range("E" & StartRow & ":E" & DeleteTo), Sheets("Admin").Range("AA5").Value)
  Sheets("Admin").Range("AC5").Value = Sheets("Admin").Range("AC5").Value + Arrow1
  Arrow2 = Application.WorksheetFunction.Countif(.Range("E" & StartRow & ":E" & DeleteTo), Sheets("Admin").Range("AA7").Value)
  Sheets("Admin").Range("AC7").Value = Sheets("Admin").Range("AC7").Value + Arrow2

 

[PlumGr8]

Two possibilities on the arrow counting. I didn't know where you wanted the counts put, so my code just refers to Z1 and Z2. Have you changed these to the correct references?

If you have, then it sounds like it isn't recognising the character numbers. So it does the check, finds nothing that it thinks matches and adds zero to both figures. If that's the case, could you get the characters from the admin sheet? From your screen shot they appear to be two cells to the left of the count, so AA5 and AA7? That section of code would then become:

  'Count arrows in range to be deleted and add to the relevant cell
  Arrow1 = Application.WorksheetFunction.Countif(.Range("E" & StartRow & ":E" & DeleteTo), Sheets("Admin").Range("AA5").Value)
  Sheets("Admin").Range("AC5").Value = Sheets("Admin").Range("AC5").Value + Arrow1
  Arrow2 = Application.WorksheetFunction.Countif(.Range("E" & StartRow & ":E" & DeleteTo), Sheets("Admin").Range("AA7").Value)
  Sheets("Admin").Range("AC7").Value = Sheets("Admin").Range("AC7").Value + Arrow2

Yep that all seemed to do it. Have tried it a few ways and works great. Got one last thing, before i mess it up haha. On that admin page I want to put a Macro button that they can hit if they want, not everyone saves it and restarts it every day etc. So, figured I would add a button so that they can either click it, or just have to run when it starts. So, how do I give it a macro name to assign it to a button?

 

[Trevor_S]

I don't think that Workbook_Open macros can be added to the button. The solution is to create it as an "ordinary" macro which can be added to a button, and make the Workbook_Open macro call that.

In the visual basic editor, create a module. Copy the existing macro into the new module, and change the first line from:
Private Sub Workbook_Open()
to:
Sub DeleteOldRows ()

Create the button and you should be able to assign the DeleteOldRows macro to it. Then replace the original macro in the Workbook area with:

Private Sub Workbook_Open()
DeleteOldRows
End Sub

When the spreadsheet is opened, the Workbook_Open macro will trigger the main DeleteOldRows macro, which then contains the code to check and delete rows.