Top Subset of Category with Most Recent as Tie Breaker

[MagiCarty]

I'm trying to pull back (based on Customer Number), their #1 Case Reason based on volume of cases, and then when there is a tie (like for 3CTI001-S or 3RTT001), bring back the most recent Case Reason as the winner (from the top tied groups).

I'm thinking there are some arrays and countifs involved here, but my brain hurts from the hours trying to figure this out. Many thanks for your help.

Excel 2010
	A	B	C	D	E	F
1	Customer Number	Case Reason	Date/Time Opened		Customer Number	Top Reason (should be)
2	101W001-S	Installation	3/7/2016 9:07		101W001-S	Installation
3	101W001-S	Installation	3/7/2016 6:15		3CTI001	Hardware Tech Support
4	101W001-S	Installation	2/24/2016 8:57		3CTI001-S	Hardware Tech Support
5	101W001-S	Software Tech Support	6/30/2016 7:55		3DCO001	Software Tech Support
6	101W001-S	Software Tech Support	6/10/2016 5:54		3RTT001	General Account Maintenance
7	3CTI001	Software Tech Support	9/22/2016 16:35		405T001	Installation
8	3CTI001	General Account Maintenance	3/16/2016 14:15
9	3CTI001	Installation	9/15/2016 13:19
10	3CTI001	Hardware Tech Support	7/14/2016 8:36
11	3CTI001	Hardware Tech Support	9/6/2016 12:24
12	3CTI001	Hardware Tech Support	9/1/2016 13:48
13	3CTI001-S	General Account Maintenance	3/15/2016 13:24
14	3CTI001-S	General Inquiries	2/2/2016 9:57
15	3CTI001-S	Hardware Tech Support	3/30/2016 9:39
16	3DCO001	Hardware Tech Support	10/31/2016 9:21
17	3DCO001	Hardware Tech Support	10/31/2016 9:12
18	3DCO001	Software Tech Support	8/17/2016 8:27
19	3GCO001	Software Tech Support	10/31/2016 12:32
20	3GCO001	Software Tech Support	8/17/2016 8:27
21	3GCO001	Software Tech Support	8/9/2016 14:11
22	3RTT001	General Account Maintenance	11/11/2016 12:19
23	3RTT001	General Account Maintenance	9/6/2016 6:26
24	3RTT001	General Inquiries	7/14/2016 10:15
25	3RTT001	General Inquiries	7/11/2016 5:46
26	3RTT001	Installation	8/24/2016 12:37
27	3RTT001	Installation	7/9/2016 7:50
28	3RTT001	Hardware Tech Support	12/1/2016 9:39
29	405T001	Finance	6/16/2016 13:42
30	405T001	Installation	1/22/2016 13:39
31	405T001	Installation	1/22/2016 12:06
32	405T001	Installation	1/22/2016 11:17
33	405T001	Installation	1/22/2016 9:48
test

 

[Eric W]

Here's a macro that should work for you.

1) Open a copy of your workbook
2) Right click on the sheet tab on the bottom and select View Code
3) From the menu, select Insert > Module
4) Paste this code into the sheet that opens:

Sub GetReasons()
Dim ResultRow As Long, Cust As String, t As Long, i As Long, MyTable As Variant

    Application.ScreenUpdating = False
    Columns("E:F").ClearContents    Range("E1").Value = "Customer"
    Range("F1").Value = "Top Reason"
    
    ResultRow = 2
    MyTable = Range("A2:C" & Cells(Rows.Count, "A").End(xlUp).Row).Value
    Cust = MyTable(1, 1)
    t = 1
    
    For i = 1 To UBound(MyTable)
        If MyTable(i, 1) <> Cust Then
            Call DoReason(MyTable, Cust, t, i - 1, ResultRow)
            t = i
            Cust = MyTable(i, 1)
        End If
    Next i
    Call DoReason(MyTable, Cust, t, i - 1, ResultRow)
    
    Application.ScreenUpdating = True
        
End Sub


Sub DoReason(MyTable, Cust, t, b, MyRow)
Dim MyDict As Object, i As Long, d As String, w As Variant, m As Double, x As Variant, y As Double

    Set MyDict = CreateObject("Scripting.Dictionary")
    For i = t To b
        d = MyTable(i, 2)
        If MyDict.exists(d) Then
            w = Split(MyDict.Item(d), Chr(9))
            MyDict.Item(d) = CDbl(w(0)) + 100000 & Chr(9) & IIf(CDbl(MyTable(i, 3)) > CDbl(w(1)), CDbl(MyTable(i, 3)), w(1))
        Else
            MyDict.Add d, 100000 & Chr(9) & CDbl(MyTable(i, 3))
        End If
    Next i
    
    d = ""
    m = 0
    For Each x In MyDict
        w = Split(MyDict.Item(x), Chr(9))
        y = CDbl(w(0)) + CDbl(w(1))
        If y > m Then
            m = y
            d = x
        End If
    Next x
    
    Cells(MyRow, "E") = Cust
    Cells(MyRow, "F") = d
    MyRow = MyRow + 1
            
End Sub

5) Tweak to match your workbook. In particular, the items in red. This macro does assume that the sheet with the data on it is active, and that the customers are in groups.
6) Press Alt-Q to exit the VBA editor
7) Press Alt-F8 to open the macro selector, choose GetReasons and click Run.

Let me know how that works. In particular, I'm curious how long it takes. On my machine, with this limited data, it takes no time at all. On a full sized data set, I couldn't say.

 

[Eric W]

This version might be a bit faster:

Sub GetReasons()
Dim ResultRow As Long, Cust As String, t As Long, i As Long, MyTable As Variant, OutTable As Variant


    Application.ScreenUpdating = False
    Columns("E:F").ClearContents
    
    ResultRow = 2
    MyTable = Range("A2:C" & Cells(Rows.Count, "A").End(xlUp).Row).Value
    ReDim OutTable(1 To UBound(MyTable), 1 To 2)
    OutTable(1, 1) = "Customer"
    OutTable(1, 2) = "Top Reason"
    
    Cust = MyTable(1, 1)
    t = 1
    
    For i = 1 To UBound(MyTable)
        If MyTable(i, 1) <> Cust Then
            Call DoReason(MyTable, Cust, t, i - 1, ResultRow, OutTable)
            t = i
            Cust = MyTable(i, 1)
        End If
    Next i
    Call DoReason(MyTable, Cust, t, i - 1, ResultRow, OutTable)
    
    Range("E1:F" & UBound(MyTable)).Value = OutTable
    Application.ScreenUpdating = True
        
End Sub


Sub DoReason(MyTable, Cust, t, b, MyRow, OutTable)
Dim MyDict As Object, i As Long, d As String, w As Variant, m As Double, x As Variant, y As Double


    Set MyDict = CreateObject("Scripting.Dictionary")
    For i = t To b
        d = MyTable(i, 2)
        If MyDict.exists(d) Then
            w = Split(MyDict.Item(d), Chr(9))
            MyDict.Item(d) = CDbl(w(0)) + 100000 & Chr(9) & IIf(CDbl(MyTable(i, 3)) > CDbl(w(1)), CDbl(MyTable(i, 3)), w(1))
        Else
            MyDict.Add d, 100000 & Chr(9) & CDbl(MyTable(i, 3))
        End If
    Next i
    
    d = ""
    m = 0
    For Each x In MyDict
        w = Split(MyDict.Item(x), Chr(9))
        y = CDbl(w(0)) + CDbl(w(1))
        If y > m Then
            m = y
            d = x
        End If
    Next x
    
    OutTable(MyRow, 1) = Cust
    OutTable(MyRow, 2) = d
    MyRow = MyRow + 1
            
End Sub

 

[MagiCarty]

I made a few tweaks and just had to make sure the data set was sorted by customer number, then case reason, and time/date, but it's working quite well it seems. Many thanks!

 

[Eric W]

You're welcome.