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

 

[PlumGr8]

I did discuss it with them, and I don't really need to worry about the deleting to next "merge" line, just need to delete past a certain X values of rows. Whether its set at 200, or 250 etc, as long as I can get it to maintain that set value auto-deleting, and tracking the up and down arrows I should be good.

 

[PlumGr8]

I've just been playing around and working on the VBA and the main sheet, I know its not full correct, but this is where I am at so far from playing around. Not sure if it is possible "but I think it is", on the main "admin" page I made a cell that says basically "enter row value here" and I have that in the Macro, just not sure if that's how it works. The first flag I did get was for "rowsOld" I figured that was right, but just wanted to try it haha. But been trying to tinker with it. Looking forward to some feedback on if I am on the right track, or WAY off haha.

Private Sub Workbook_Open()


Sheets("Truck Data").Unprotect

RowsOld = sheets(“Admin”).value = (“J5”)

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("Sortie Flow Data")

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 - RowsOld) Then

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

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

If .Range("E" & CheckRow).Value = ChrW(2193) Then .Range("AF6").Value = .Range("AF6").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("Truck Data").Protect



End Sub







Thanks again for everything.

 

[Trevor_S]

Sorry for the delay - it's been a busy few weeks!

If the mispelling of Saturday was a mistype by you, it's possible that there may still be "real" dates within the merged cells - in which case deleting based on date may still be an option. But can't be certain about this.

From your latest code, you now seem to be working on a different sheet?

I assume that you're using "RowsOld" as the number of records to delete, and picking the number up from cell J5 on the Admin sheet? If so, you need to change this line:

RowsOld = sheets(“Admin”).value = (“J5”)

to

RowsOld = Sheets(“Admin”).Range(“J5”).Value

But after that, there will be more significant changes! The old macro looked at the date on every row and calculated whether it was old enough for deletion. This was done by looking at the date on the row and working out whether it was earlier than the current date minus the number of days to be kept, in this line:

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

But if you're just deleting a set number of records, you don't need a date comparison. You just need to keep track of the number of records deleted and stop when you reach the number you want to delete.

The following would hopefully work, but obviously I can't test it to be certain. Suggest that you make a copy of the spreadsheet, manually work out what your expected outcome should be, then run this macro on it and see if it matches! I'm assuming that the amendments made earlier to identify arrows work. If the lines containing ChrW(2191) and Chrw(2193) don't work, I haven't got any other suggestions on that!

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
  RecordsDeleted = 0 'This is a counter of the number of rows deleted
  Application.EnableEvents = False
  Application.ScreenUpdating = False
    With Sheets("Sortie Flow Data")
      Do 'Go through records until the selected number have been deleted.
        If RecordsDeleted = RowsOld 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
  Application.ScreenUpdating = True
  Application.EnableEvents = True
Sheets("Truck Data").Protect
End Sub

 

[PlumGr8]

SO

So I just copied and tried that, but goan error on the "RowsOld". I am not even sure that is the correct code, is it? If its an error in reference to the admin sheet i can work on that a little bit. If I hover over the yellow error line, it says "rowsold = empty" etc as I go across.

 

[Trevor_S]

Try deleting the quote symbols before and after "Admin" and "J5" on that line, then re-enter them. I drafted my earlier reply in notepad before copying and pasting into this forum, and it looks like doing this has turned straight quotes ("...") into curly ones like this (“...”). Although they look fairly similar, Excel treats them as different characters. All quote symbols in VBA should be the straight ("...") ones.

 

[PlumGr8]

I deleted the quote, put it in under the workbook section in VB, it didn't flag any errors when I entered it, saved it etc. But when I go to open the file it freezes, and has been across a couple workbook examples. I'm wondering if its just looking for ANY rows beyond the set value and deleting them, whether it has any data or not?

 

[Trevor_S]

If the correct type of quotes are now in place, the next possibility is that the contents of cell J5 aren't being treated as an integer. The code:

If RecordsDeleted = RowsOld Then Exit Do

looks for an exact match between the count of records deleted and the number in cell J5 as stored in RowsOld. So if RowsOld wasn't an interest, it would keep going straight past it. Perhaps a better test would be to convert RowsOld to an integer, then check when the count of records deleted has exceeded one less than the value of RowsOld. This code would be:

If RecordsDeleted > Int(RowsOld) - 1 Then Exit Do

If you then get an error highlighting the Int(RowsOld) part, it implies that it doesn't consider the contents of cell J5 to be a number.

 

[PlumGr8]

I'll try that here in a few. Would it be easier if on that same main sheet I just had the value in a cell up to? Like Row 3 Column L? Or something like that, just so that it wouldn't have to look to another sheet?

 

[Trevor_S]

Looking up the value from a different sheet shouldn't be a problem, now that the reference to the sheet and cell are corrected. Hopefully this latest change should stop it running continuously!

 

[PlumGr8]

Looking up the value from a different sheet shouldn't be a problem, now that the reference to the sheet and cell are corrected. Hopefully this latest change should stop it running continuously!

So, gave that a shot, still freezing the sheet. I enter the VBA under workbook, and save it no issues, as soon as I put a row value in and restart it, it locks up the sheet. This is the Code I currently have

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

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

Application.EnableEvents = False

Application.ScreenUpdating = False

With Sheets("Truck Data")

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

Application.ScreenUpdating = True

Application.EnableEvents = True

Sheets("Truck Data").Protect

End Sub


I got them to agree to an overall setup, still following this image. I have a couple boxes to the right to keep track of the up and down arrows, similar to what I had before. A running total, overall, that also kept up with all the deleted ones.