VBA Code that will return max date based on multiple criteria

Can you post a sample file? (Go to advanced and click on the paper clip.)

I'll take a look tomorrow.

Hi dubuquer,

Here's a start - see if it's what you wanted:

Sub Dubuquer(): Dim OT As String, TS As Date, n As Integer
Dim r As Long, i As Long, mr As Long, HT As String: n = 2
r = Range("B" & Rows.Count).End(xlUp).Row: HT = Cells(r, 2)
    For i = r To 2 Step -1
                            OT = Cells(i, 2)
GetHigh:
    If HT = OT Then
    If Cells(i, 5) > TS Then
    TS = Cells(i, 5): mr = i: End If
    Else:                   GoSub ColorPost
    n = n + 1: HT = OT: TS = #12:00:00 AM#: GoTo GetHigh
    End If
    Next i
                            GoSub ColorPost
    Exit Sub
ColorPost:
            Cells(mr, 5).Font.ColorIndex = 3
    Cells(n, 6) = "The maximum date for " & HT & " is " & TS
                            Return
End Sub

Directions for running the routine(s) just supplied

Copy the code to the clipboard

Press ALT + F11 to open the Visual Basic Editor.

Open a macro-enabled Workbook or save your Workbook As Macro-Enabled

Select “Module” from the Insert menu

Type "Option Explicit" then paste the code under it

And, you should be ready to go

With the cursor between Sub and End Sub press F5 (F8 to Single Step)

OR

Press ALT + Q to close the code window.

Press ALT + F8 then double click on the macro name

Hi Dubuquer,

It's a little sloppy but it seems to do what you want:

Sub Dubuquer(): Dim wd As Worksheet, wt As Worksheet
Dim OT As String, TS As Date, TW As Date, TY As Date
Dim r As Long, i As Long, mr As Long, HT As String

    Set wd = ActiveWorkbook.Sheets("Data")
        wd.Cells.Font.ColorIndex = xlAutomatic
            Set wt = ActiveWorkbook.Sheets("Time")
        
r = wd.Range("B" & Rows.Count).End(xlUp).row: HT = wd.Cells(r, 2)
    For i = r To 2 Step -1
                            OT = wd.Cells(i, 2)
GetHigh:
    If HT = OT Then
    If wd.Cells(i, 5) > TS Then
    TS = wd.Cells(i, 5): mr = i: End If
    Else:                   GoSub ColorPost
    HT = OT: TS = #12:00:00 AM#: GoTo GetHigh
    End If
    Next i
                            GoSub ColorPost
    Exit Sub
ColorPost:
            wd.Cells(mr, 5).Font.ColorIndex = 3
            If HT = "CTR" Then
    wt.Cells(7, 3) = "The maximum date for " & HT & " is " & TS
            wt.Cells(7, 5) = TS
            ElseIf HT = "BTW" Then
                    TW = TS
    wt.Cells(10, 3) = "The maximum date for " & HT & " is " & TS
            ElseIf HT = "ATY" Then
                    TY = TS
    wt.Cells(9, 3) = "The maximum date for " & HT & " is " & TS
             End If
             If TY And TW Then
             If TY > TW Then
             TS = TY
             Else
             TS = TW: End If
             wt.Cells(9, 5) = TS: End If
                            Return
End Sub

You're welcome!