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]

I can't see what's causing the problem, so need to do some troubleshooting! A couple of things to try:

Put a single quote at the start of this line:
Application.ScreenUpdating = False
This will stop the line being actioned. The purpose of the line is there to stop any changes caused by the macro appearing on screen until the macro has finished. But it means that when it "freezes" you don't know if it's still doing anything. Without that line being actioned, you should be able to see if it's freezing before deleting anything, or deletes all of the records and just appears to be freezing because it doesn't know when to stop! Once you've tested this, take the single quote back out so the line is back to how it was.

Another thing to try - change the third line (the one starting RowsOld) to:
RowsOld = 10
If when you open the spreadsheet again it deletes the first 10 records without freezing, then the problem is with whatever is in cell J5 of the admin sheet.

 

[PlumGr8]

I can't see what's causing the problem, so need to do some troubleshooting! A couple of things to try:

Put a single quote at the start of this line:
Application.ScreenUpdating = False
This will stop the line being actioned. The purpose of the line is there to stop any changes caused by the macro appearing on screen until the macro has finished. But it means that when it "freezes" you don't know if it's still doing anything. Without that line being actioned, you should be able to see if it's freezing before deleting anything, or deletes all of the records and just appears to be freezing because it doesn't know when to stop! Once you've tested this, take the single quote back out so the line is back to how it was.

Another thing to try - change the third line (the one starting RowsOld) to:
RowsOld = 10
If when you open the spreadsheet again it deletes the first 10 records without freezing, then the problem is with whatever is in cell J5 of the admin sheet.

So I tried that, and its still freezing the excel sheet. I Even shortened my sheet to 20 rows just to play with and it just bricks as soon as I open it and enable the macro. I feel like I have something simple messed up, I just have no idea what it is.

 

[Trevor_S]

One more idea to try and identify the issue. Work your way down the code, and on each line press the F9 key. It won't work on some lines (you'll get a message saying "Breakpoint not allowed on this line") - but it should work on most of them. A brown dot will appear to the left of the line, and the line will be shaded brown.

When you now run the macro, it will stop on every line, and you'll need to click on the play button (arrow pointing to the right) on the toolbar to get it to run the next line. From this you should be able to tell how much (if any) of the macro has run before it freezes, which should help identify where the problem is.

 

[PlumGr8]

Do 'Go through records until the selected number have been deleted.


If RecordsDeleted > Int(RowsOld) -1 Then Exit Do 'The selected number of records have been deleted, so leave the Do...Loop section


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


If .Range("E" & StartRow).Value = ChrW(2191) Then .Range("AF5").Value = .Range("AF5").Value + 1


If .Range("E" & StartRow).Value = ChrW(2193) Then .Range("AF6").Value = .Range("AF6").Value + 1


'Then delete the record


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


RecordsDeleted = RecordsDeleted + 1 'Add one to the number of records deleted


Loop


End With

One more idea to try and identify the issue. Work your way down the code, and on each line press the F9 key. It won't work on some lines (you'll get a message saying "Breakpoint not allowed on this line") - but it should work on most of them. A brown dot will appear to the left of the line, and the line will be shaded brown.

When you now run the macro, it will stop on every line, and you'll need to click on the play button (arrow pointing to the right) on the toolbar to get it to run the next line. From this you should be able to tell how much (if any) of the macro has run before it freezes, which should help identify where the problem is.

Ok so I tried that and making progress. I highlighted it in red above, but the "RecordsDeleted = RecordsDeleted +1....." is where it locks up.

 

[Trevor_S]

Ok, so the problem seems to be either when it's trying to increment the counter (RecordsDeleted) of the number of rows deleted, or when it tries to compare that counter with the RowsOld variable on the second time through the "Do...Loop" loop. I really can't see why - but here's an alternative way of doing it, using a "For...Next" loop to replace both the counter and the "Do...Loop" loop.

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")
  For n = 1 to RowsOld
    'This record needs to be deleted - check if it contains any Job Sites and update the totals
    If .Range("E" & StartRow).Value = ChrW(2191) Then .Range("AF5").Value = .Range("AF5").Value + 1
    If .Range("E" & StartRow).Value = ChrW(2193) Then .Range("AF6").Value = .Range("AF6").Value + 1
    'Then delete the record
    .Range("A" & StartRow & ":M" & StartRow).Delete (xlShiftUp)
  Next
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
Sheets("Truck Data").Protect
End Sub

As before - if this still freezes, see if you can work out how far it gets using the F9 breakpoints.

Given that we're now deleting a fixed number of rows rather than testing the dates on individual rows, another alternative may be to avoid a loop altogether. The macro could:

• calculate the row range for the records to be deleted (based on the StartRow plus RowsOld)
• count the number of up and down arrows in column E for that row range, and add them to AF5 and AF6
• delete the records in one block.

But see if the above works first...

 

[Trevor_S]

If the above doesn't work, then this is the code that I think should do the deletion in a single step, without the need for a loop:

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))
  .Range("AF5").Value = .Range("AF5").Value + Arrow1
  Arrow2 = Application.WorksheetFunction.Countif(.Range("E" & StartRow & ":E" & StartRow + RowsOld - 1), ChrW(2193))
  .Range("AF6").Value = .Range("AF6").Value + Arrow2
  'Then delete the records
  .Range("A" & StartRow & ":M" & StartRow).Delete (xlShiftUp)
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
Sheets("Truck Data").Protect
End Sub

 

[PlumGr8]

Ok, so I tried both of those, still freezeing up.

They both seem to freeze on the line following ".Range("A" & StartRow & ":M" & StartRow).Delete (xlShiftUp)", so it locks on the 1st one when it hits the "Next" line, and the 2nd one at "End Width".

I did change one thing, instead of referring to the admin page for a value, I have it on K3 on the Truck Data page.

 

[Trevor_S]

Are you able to manually do that bit of the process - i.e. select exactly cells A4 to M4, right click and delete those cells, so that the cells below move up?

If it won't let you do that manually (for whatever reason) it would explain why the macro can't do it!

One possible thing that might stop it working either manually or with the macro would be if any of the merged cells extend beyond column M - because it can't move up part of a merged cell.

 

[Trevor_S]

Just tested my theory. I merged cells A5:N5 on a blank spreadsheet, then tried to delete A4:M4 shifting cells up. An error message is displayed "This operation will cause some merged cells to unmerge. Do you wish to continue?"

So if the macro tried to do a deletion like this, it wouldn't know how to handle the error, making it appear to freeze.

 

[PlumGr8]

Just tested my theory. I merged cells A5:N5 on a blank spreadsheet, then tried to delete A4:M4 shifting cells up. An error message is displayed "This operation will cause some merged cells to unmerge. Do you wish to continue?"

So if the macro tried to do a deletion like this, it wouldn't know how to handle the error, making it appear to freeze.

Ok, I "think" I have an idea. It does freak out if I select just A to M and delete, but it doesn't freak out if I just delete rows without limiting. The only real reason I limited it to A&M was because of those up and down tracking that I have. I also have them mirrored on the admin page. If I just have the information point to those cells on the admin page, and have nothing else on the data page, then I should be ok? So I should just have to alter the details on the admin page and the macro to reference there, and should be good from there?