VBA to find the maximum value against a single criteria

[lopiteaux]

I need to find the maximum value present in column AC against multiple instances of variable X in column D, and populate the value in column F.

For example (apologies, I cannot share a true dataset due to the confidential nature of the data):

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]Column D[/TD]
[TD]...[/TD]
[TD]Column F[/TD]
[TD]...[/TD]
[TD]Column AC[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]ID[/TD]
[TD]...[/TD]
[TD]MaxSeverity[/TD]
[TD]...[/TD]
[TD]Severity[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]A[/TD]
[TD]...[/TD]
[TD]50[/TD]
[TD]...[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]A[/TD]
[TD]...[/TD]
[TD]50[/TD]
[TD]...[/TD]
[TD]50[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]B[/TD]
[TD]...[/TD]
[TD]30[/TD]
[TD]...[/TD]
[TD]20[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]C[/TD]
[TD]...[/TD]
[TD]30[/TD]
[TD]...[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]A[/TD]
[TD]...[/TD]
[TD]50[/TD]
[TD]...[/TD]
[TD]40[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]B[/TD]
[TD]...[/TD]
[TD]30[/TD]
[TD]...[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]B[/TD]
[TD]...[/TD]
[TD]30[/TD]
[TD]...[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]C[/TD]
[TD]...[/TD]
[TD]30[/TD]
[TD]...[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]D[/TD]
[TD]...[/TD]
[TD]50[/TD]
[TD]...[/TD]
[TD]50[/TD]
[/TR]
</tbody>[/TABLE]


I've got a solution which uses nested CountIfs, but it takes around 45s on a dataset of 10k rows and is, well, inelegant to say the least.

Any suggestions from the community?

 

[njimack]

Your post title refers to VBA but you stated that you'd tried nested COUNTIFs. If you're happy with a formula, try the below, confirm with ctrl+shift+enter:
=MAX(IF($D$2:$D$10=D2,$AF$2:$AF$10))

 

[lopiteaux]

Your post title refers to VBA but you stated that you'd tried nested COUNTIFs. If you're happy with a formula, try the below, confirm with ctrl+shift+enter:
=MAX(IF($D$2:$D$10=D2,$AF$2:$AF$10))

I'm using nested CountIfs in VBA:

        For r = 2 To Cells(Rows.Count, "I").End(xlUp).Row
            If .Cells(r, "A") = "Y" Then
                If WorksheetFunction.CountIfs(Columns(cId), .Cells(r, cId), Columns(cSeverity), "50") > 0 Then
                    .Cells(r, "F").Value = "50"
                Else
                    If WorksheetFunction.CountIfs(Columns(cId), .Cells(r, cId), Columns(cSeverity), "40") > 0 Then
                        .Cells(r, "F").Value = "40"
                    Else
                        If WorksheetFunction.CountIfs(Columns(cId), .Cells(r, cId), Columns(cSeverity), "30") > 0 Then
                            .Cells(r, "F").Value = "30"
                        Else: End If
                    End If
                End If
            Else
                .Cells(r, "F").Value = "NA"
            End If
        Next r

 

[njimack]

No wonder it takes so long, running up to 3 COUNTIFs functions on 10,000 rows. Are you able to sort the data by column D and then column AC? If so, there's a much quicker way of determining the max value. Otherwise, I'd suggest writing the formula I gave you to all cells in column F.

 

[lopiteaux]

No wonder it takes so long, running up to 3 COUNTIFs functions on 10,000 rows. Are you able to sort the data by column D and then column AC? If so, there's a much quicker way of determining the max value. Otherwise, I'd suggest writing the formula I gave you to all cells in column F.

I'd prefer not to sort, but am happy to test it. What is your suggestion based on sorting? I want to avoid formulas in cells.

FYI, the same nested CountIf as a formula in cells takes around 8 seconds to complete.

 

[njimack]

I'd prefer not to sort, but am happy to test it. What is your suggestion based on sorting? I want to avoid formulas in cells.

FYI, the same nested CountIf as a formula in cells takes around 8 seconds to complete.

OK, assuming you've sorted on ID (A to Z) and Severity (largest to smallest), I would suggest something like this:

Sub Severity()
Dim c As Range
Dim lastRow As Long
Application.ScreenUpdating = False
With Sheets("Sheet1") ' change sheet name as required
    lastRow = .Cells(Rows.Count, 4).End(xlUp).Row
    
    For Each c In Range(.Cells(2, 4), .Cells(lastRow, 4))
        If c = c.Offset(-1) Then
            .Cells(c.Row, 6) = .Cells(c.Row - 1, 6)
        Else
            .Cells(c.Row, 6) = .Cells(c.Row, 29)
        End If
    Next c
End With
        
            
Application.ScreenUpdating = True
End Sub

If you want to preserve the original order of the data, my suggestion would be to include another column that starts at 1 in row 2 and increments down all the way to 10,000. You can then use VBA to sort the data, run the above code, and then re-sort it based on the helper column.