VBA tag most recent date for each reference

[M4TVD]

I am trying to create some VBA that will mark the relevent row in (column A) if the date (column L) and time (column M) is the most recent for each occurance in column B.

For example column B is a vehicle reg number and a row of information about the vehicle is inputted each time there is service or work carried out on the vehicle with the date and time of the work. There are multiply vehicles (say more than 20) and I want to be able to easily see what the most recent service or work for each vehicle is by using filters. but i need column A to highlight the most recent.

I hope this makes sense.

I have the following code that I can not make work.

Sub TagMostRecent()

NRows = 500

AllTheRecords = Range("A8:T" & NRows)


'compile a list of unique reg numbers
Dim NSerials()
ReDim NSerials(1)

For ii = 1 To NRows - 1
  ThisNSerial = AllTheRecords(ii, 2)
  kk = 1
  bFoundIt = 0
  While (bFoundIt = 0) And (kk < UBound(NSerials, 1))
    If StrComp(ThisNSerial, NSerials(kk)) = 0 Then
       bFoundIt = 1
    End If
    kk = kk + 1
  Wend
  If (bFoundIt = 0) And (Len(ThisNSerial) > 0) Then
     NSerials(UBound(NSerials)) = AllTheRecords(ii, 2)
     NewUBound = UBound(NSerials) + 1
     ReDim Preserve NSerials(NewUBound)
     
  End If
  

Next ii

'Range("A8:A" & NRows).Clear

For ii = 1 To NRows - 1
  AllTheRecords(ii, 1) = ""
Next ii



'for each serial number walk down the array and find the most recent record
For ii = 1 To UBound(NSerials) - 1
  CurrentDateAndTime = 0
  For jj = 1 To NRows - 1
     If StrComp(AllTheRecords(jj, 2), NSerials(ii)) = 0 Then
        If Len(AllTheRecords(jj, 13)) = 0 Then
           AllTheRecords(jj, 13) = 0 'if no time is found set it to zero (midnight)
        End If
        DateAndTime = AllTheRecords(jj, 12) + AllTheRecords(jj, 13)
        If DateAndTime > CurrentDateAndTime Then
           CurrentDateAndTime = DateAndTime
            iiMostRecent = jj
        End If
        
     End If
    
  Next jj
  AllTheRecords(iiMostRecent, 1) = 1
  
Next ii

Dim OutputColumn()
ReDim OutputColumn(NRows, 1)
For ii = 1 To NRows - 1
  OutputColumn(ii, 1) = AllTheRecords(ii, 1)
Next ii


Range("A8:A" & NRows + 1).Value = OutputColumn


End Sub

thanks for any help

 

[M4TVD]

When I try to run this code I get the following message: