life_in_picture_format
New Member
- Joined
- Dec 8, 2021
- Messages
- 26
- Office Version
- 365
- Platform
- Windows
- Mobile
- Web
I'm pretty happy with myself for getting this far on this idea of mine. When we write an employee up its based on a 12 month rolling period. So in other words they have that on their record for 12 month from the date. No one
was keeping track and it was a mess so I made this tracker. As of recent I figured out the code to remove entries that had expired of the sheet and onto a sheet I titled "Archives"
Here is the code:
So I went from this:
To this but I could not figure out how to add "Delete empty rows" to the code as the finishing touch. Anyone know what I need to add to get it to do that?
was keeping track and it was a mess so I made this tracker. As of recent I figured out the code to remove entries that had expired of the sheet and onto a sheet I titled "Archives"
Here is the code:
VBA Code:
Private Sub Workbook_Open()
b = Worksheets("DPS Disciplinary Actions").Cells(Rows.Count, 3).End(xlUp).Row 'open workbook as trigger
Dim answer As Integer
answer = MsgBox("Excel is checking to see if there are any DPS Infractions that have expired. ", vbCritical + vbOKOnly, "One Moment Please...") 'msgbox1 to tell folks Excel is working
'by clicking ok for the previous msgboxit triggers another allowing excel to finish the process
answer = MsgBox("If Excel locates and moves these old records, you will be able to see them on the Sheet Titled ""Archives""", vbInformation + vbOKOnly, "Just so You Know...")
'loop to check expired entries and place them on the archives sheet
For i = 4 To b
If Worksheets("DPS Disciplinary Actions").Cells(i, 4).Value = "EXPIRED" Then
Worksheets("DPS Disciplinary Actions").Rows(i).Cut 'cut and paste to the Archives sheet
Worksheets("Archives").Activate
a = Worksheets("Archives").Cells(Rows.Count, 3).End(xlUp).Row
Worksheets("Archives").Cells(a + 1, 1).Select
ActiveSheet.Paste
Worksheets("DPS Disciplinary Actions").Activate
End If
Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets("DPS Disciplinary Actions").Cells(1, 1).Select
End Sub
So I went from this:
To this but I could not figure out how to add "Delete empty rows" to the code as the finishing touch. Anyone know what I need to add to get it to do that?
Attachments
Last edited by a moderator: