How to purge records older than 8 hours? - excel

Question

I have a worksheet with records (database). In Column B is the date the record was created (dd-MMM-yyyy format). In Column C I have the time it was created (HH:MM 24hr format).
The problem I'm having, is purging the records older than 8 hours from current system time. This code works at purging previous day records for the current finance period, but it is not taking into account 24hr format and after midnight for records older than 8 hours. I have tried many different approaches to this but still unable to figure this out.
This is the code I have since the last time I tried to figure this out:
'------------------------
' Current Finance Period
'------------------------
cSheet = CStr(Format(cStartDate, "dd-MMM-yyyy")) & " - " & CStr(Format(cEndDate, "dd-MMM-yyyy")) `Set the sheet name to use (current finance period)
CreateSheetIf (cSheet) `Create sheet if not exists
cFTarget = wbFinance.Worksheets(cSheet).UsedRange.Rows.Count `count the rows used
Set wscFinance = wbFinance.Worksheets(cSheet)
MRCForm.Caption = "MRC [ Processing... " & cSheet & " Ready to Finance records... Please wait... ]"
Me.sysMsgBox.Value = " Purging records, between " & cSheet & ", marked Ready for Finance..."
Application.ScreenUpdating = False
If cFTarget = 1 Then
If Application.WorksheetFunction.CountA(wscFinance.UsedRange) = 0 Then cFTarget = 0
End If
Source = wsMRC.UsedRange.Rows.Count
Set xRg = wsMRC.Range("AF2:AF" & Source)
Set dRg = wsMRC.Range("B2:B" & Source) `Date column in dd-MMM-yyyy format
Set tRg = wsMRC.Range("C2:C" & Source) `Time column in HH:MM 24hr format
On Error Resume Next
For K = 1 To xRg.Count
If dRg(K).Value = "" Or tRg(K).Value = "" Or xRg(K).Value = "" Then Exit For
If Format(dRg(K).Value, "dd-MMM-yyyy") >= Format(cStartDate, "dd-MMM-yyyy") And Format(dRg(K).Value, "dd-MMM-yyyy") < CStr(Format(Now, "dd-MMM-yyyy")) Then ' If date is within current finance period then
If CStr(xRg(K).Text) = "Y" Then
xRg(K).EntireRow.Copy Destination:=wscFinance.Range("A" & cFTarget + 1)
xRg(K).EntireRow.Delete
cFTotal = cFTotal + 1
MRCForm.Caption = "MRC [ Processing... " & cSheet & " (" & cFTotal & ") Please wait... ]"
If CStr(xRg(K).Value) = "Y" Then
K = K - 1
End If
cFTarget = cFTarget + 1
End If
End If
Next
Source = wsMRC.UsedRange.Rows.Count
Set xRg = wsMRC.Range("AF2:AF" & Source)
Set dRg = wsMRC.Range("B2:B" & Source) `Date column in dd-MMM-yyyy format
Set tRg = wsMRC.Range("C2:C" & Source) `Time column in HH:MM 24hr format
On Error Resume Next
For K = 1 To xRg.Count
If dRg(K).Value = "" Or tRg(K).Value = "" Or xRg(K).Value = "" Then Exit For
If Format(dRg(K).Value, "dd-MMM-yyyy") = CStr(Format(Now, "dd-MMM-yyyy")) And Format(tRg(K).Value, "HH:MM") <= Format(Now - TimeValue("08:00"), "HH:MM") Then ' If time is greater or equal to 8 hours ago then
If CStr(xRg(K).Text) = "Y" Then
xRg(K).EntireRow.Copy Destination:=wscFinance.Range("A" & cFTarget + 1)
xRg(K).EntireRow.Delete
cFTotal = cFTotal + 1
MRCForm.Caption = "MRC [ Processing... " & cSheet & " (" & cFTotal & ") Please wait... ]"
If CStr(xRg(K).Value) = "Y" Then
K = K - 1
End If
cFTarget = cFTarget + 1
End If
End If
Next
wscFinance.Columns("A:AM").AutoFit
Application.ScreenUpdating = True
Application.ScreenUpdating = True
I know the code is not very clean, just trying to get something that will function for now, will try to clean it up at a later date. Might even look at creating Functions as reusable code is more efficient.

Answer 1

Mock-up:
current time 11:45 on 2018.03.06
storing log date in column A
storing log time in column B
Untested code:
Dim i as long, lr as long, y as long, a as long, b as long
lr = cells(rows.count,1).end(xlup).row
For i = lr to 2 Step -1
y = TimeValue(now())-8
If y < 0 Then
a = Date(Now())-1
b = 24 + y 'y should be a negative value
Else
a = Date(Now())
b = y
End If
If Cells(1,1)=a AND Cells(1,2)>=b Then
.Rows(i).Delete
End If
Next i
Intention of this code:
loop through each row and delete the whole row if criteria met
find what 8 hours before Now() was and store as y... with the current time/date it is 03:45 on 2018.03.06, y = 3:45
If we save the current time is 02:00 on 2018.03.06 then y = -6:00
based on y being +/-, you determine the day and time
24 hour based time for where y is negative, so you add the negative number... in the case of y = -6, 24+(-6) = 18, so 18:00 hours, and the previous date (z)
you then assess the current row based on if the date matches AND if the time is less than or equal to z and y, respectively
This should be a starting point.