How to update an existing Macro step in Excel

Hi Kirby Lutz

It has been a while and I am writing to see how things are going with this issue.

Have you had a chance to check the replies provided?

Any update would be appreciated.

Hi, Kirby Lutz

Welcome to Microsoft Q&A forum.

Thanks for your question. In this case you want your macro to handle ties automatically for columns I (hi game) and J (hi series) across DIV A-D, highlight top three distinct values (yellow, blue, green), clear any previous highlights beyond those groups, and then resort by high average (M), tie‑broken by K.

Below is a robust VBA refactor that:

• Removes existing highlights first
• Sorts the division by the target column (I or J) high>low
• Finds the top three distinct values (dense ranking) and highlights all ties for each rank
• Boldifies only the highlighted cells
• Finally, re‑sorts the block by M (desc), then K (desc)

It avoids Select/Activate for reliability and is written so you can run it for DIV_A, DIV_B, DIV_C, DIV_D.

VBA: Highlight top‑3 with ties, then resort by average

Put this in a standard Module (e.g., Module1). Make sure named ranges DIV_A, DIV_B, DIV_C, DIV_D each cover the division rows (e.g., 24:33) across columns A:V on their respective sheet.

Option Explicit
 
' Color constants (match your existing macro)
Private Const COLOR_YELLOW As Long = 65535          ' top group
Private Const COLOR_BLUE As Long = 15773696         ' second group
Private Const COLOR_GREEN As Long = 5296274         ' third group
' Entry point: run this
Public Sub UpdateHighlightsForAllDivisions()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    On Error GoTo CleanExit
    ProcessDivision "DIV_A"
    ProcessDivision "DIV_B"
    ProcessDivision "DIV_C"
    ProcessDivision "DIV_D"
CleanExit:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
' Process a single division by name
Private Sub ProcessDivision(ByVal divName As String)
    Dim block As Range
    Dim firstRow As Long, lastRow As Long
    Dim ws As Worksheet
    ' Resolve the named range to a concrete Range
    On Error Resume Next
    Set block = Range(divName)
    On Error GoTo 0
    If block Is Nothing Then
        MsgBox "Named range '" & divName & "' not found.", vbExclamation
        Exit Sub
    End If
    Set ws = block.Worksheet
    firstRow = block.Rows(1).Row
    lastRow = block.Rows(block.Rows.Count).Row
    ' I and J columns inside this division block
    Dim rngI As Range, rngJ As Range
    Set rngI = ws.Range("I" & firstRow & ":I" & lastRow)
    Set rngJ = ws.Range("J" & firstRow & ":J" & lastRow)
    ' 1) Clear existing highlights in I and J in the division
    rngI.Interior.ColorIndex = xlNone
    rngI.Font.Bold = False
    rngJ.Interior.ColorIndex = xlNone
    rngJ.Font.Bold = False
    ' 2) Sort the division by I (hi game), highlight top3 with ties
    SortBlockByColumn block, rngI
    HighlightTop3WithTies rngI, COLOR_YELLOW, COLOR_BLUE, COLOR_GREEN
    ' 3) Sort the division by J (hi series), highlight top3 with ties
    SortBlockByColumn block, rngJ
    HighlightTop3WithTies rngJ, COLOR_YELLOW, COLOR_BLUE, COLOR_GREEN
    ' 4) Final resort by M (hi average) desc, then K desc
    ResortByAverage block
End Sub
' Sort the entire division block using the given key column range (I or J)
Private Sub SortBlockByColumn(ByVal block As Range, ByVal keyCol As Range)
    With block.Worksheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=keyCol, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SetRange block
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
End Sub
' Highlight the top three distinct values (dense ranks) with ties in the provided single-column range
Private Sub HighlightTop3WithTies(ByVal colRange As Range, _
                                  ByVal colorRank1 As Long, _
                                  ByVal colorRank2 As Long, _
                                  ByVal colorRank3 As Long)
    Dim groupVals(1 To 3) As Variant
    Dim groupsFound As Long
    Dim i As Long, v As Variant
    groupsFound = 0
    ' Find up to three distinct values scanning from top (already sorted desc)
    For i = 1 To colRange.Rows.Count
        v = colRange.Cells(i, 1).Value
        If IsEmpty(v) Or v = "" Then
            ' skip blanks
        Else
            If groupsFound = 0 Then
                groupsFound = 1: groupVals(1) = v
            ElseIf v <> groupVals(groupsFound) Then
                groupsFound = groupsFound + 1
                If groupsFound <= 3 Then
                    groupVals(groupsFound) = v
                Else
                    Exit For ' we already captured 3 distinct groups
                End If
            End If
        End If
    Next i
    ' Apply colors to ties across the column
    For i = 1 To colRange.Rows.Count
        v = colRange.Cells(i, 1).Value
        With colRange.Cells(i, 1)
            .Interior.ColorIndex = xlNone
            .Font.Bold = False
            If groupsFound >= 1 And v = groupVals(1) Then
                .Interior.Color = colorRank1
                .Font.Bold = True
            ElseIf groupsFound >= 2 And v = groupVals(2) Then
                .Interior.Color = colorRank2
                .Font.Bold = True
            ElseIf groupsFound >= 3 And v = groupVals(3) Then
                .Interior.Color = colorRank3
                .Font.Bold = True
            End If
        End With
    Next i
End Sub
' Final resort: M desc, then K desc for the division block
Private Sub ResortByAverage(ByVal block As Range)
    Dim ws As Worksheet
    Dim firstRow As Long, lastRow As Long
    Set ws = block.Worksheet
    firstRow = block.Rows(1).Row
    lastRow = block.Rows(block.Rows.Count).Row
    With ws.Sort
        .SortFields.Clear
        .SortFields.Add Key:=ws.Range("M" & firstRow & ":M" & lastRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SortFields.Add Key:=ws.Range("K" & firstRow & ":K" & lastRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SetRange block
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
End Sub

Why this fixes ties cleanly

• The macro dense‑ranks the column values after sorting, capturing the first 3 distinct scores only.
• All rows that share a top value (ties) get the same color group.
• Any rows beyond these three groups are cleared (no highlight, not bold), so you don’t have to manually remove previous tie fixes.
• It runs for both I and J and then gives you your preferred final sort by M (average) with K as the secondary key, exactly like your original code.

Notes and tips

• Keep your named ranges (DIV_A, DIV_B, DIV_C, DIV_D) aligned to rows 24:33 and across A:V so the sort uses the whole block.
• If some divisions have fewer bowlers, the code still works; it just scans whatever the named range covers.
• If you ever switch colors, change the three Const values at the top.

Optional: formula/Conditional Formatting approach (no VBA)

If you’d rather make it worksheet‑driven, you can compute a dense rank per division using a helper column and apply three conditional formats (rank = 1, 2, 3). That works great long‑term, but given your sort requirement by I/J first and then M/K, the VBA above keeps your existing workflow intact and is simpler to drop in.

Hope this helps. Feel free to get back if you need further assistance.

If the answer is helpful, please click "Accept Answer" and kindly upvote it. If you have extra questions about this answer, please click "Comment."    

Note: Please follow the steps in our documentation to enable e-mail notifications if you want to receive the related email notification for this thread.