'================================================================================
' MAP EXCEL COLOUR INDEX
' Run this on a blank sheet to generate a reference of all 56 ColorIndex values
' showing the colour, index number, hex code and RGB values
' Donna Graham 2026
'================================================================================

Sub MapColorIndex()

    Dim i As Integer
    Dim ws As Worksheet
    Dim hexCode As String
    Dim colourLong As Long
    Dim r As Integer, g As Integer, b As Integer
    
    Set ws = ActiveSheet
    
    ' Clear any existing formatting on the output range first
    ws.Range("A1:D57").Clear
    
    ' Set consistent font across entire output range
    With ws.Range("A1:D57")
        .Font.name = "Calibri"
        .Font.Size = 11
        .Font.Color = RGB(51, 51, 51)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    
    ' Set column widths
    ws.Columns("A").ColumnWidth = 15      ' ColorIndex swatch
    ws.Columns("B").ColumnWidth = 15      ' Hex Code
    ws.Columns("C").ColumnWidth = 16.57   ' RGB - slightly wider for the numbers
    ws.Columns("D").ColumnWidth = 15      ' VBA ColorIndex
    
    ' Set a standard row height
    ws.Rows("1:57").RowHeight = 20
    
    ' Add headers
    ws.Cells(1, 1).Value = "ColorIndex"
    ws.Cells(1, 2).Value = "Hex Code"
    ws.Cells(1, 3).Value = "RGB"
    ws.Cells(1, 4).Value = "VBA ColorIndex"
    
    ' Style headers
    With ws.Range("A1:D1")
        .Font.Bold = True
        .Font.Size = 11
        .Font.name = "Calibri"
        .Interior.ColorIndex = 15
        .Font.Color = RGB(51, 51, 51)
        .HorizontalAlignment = xlCenter
    End With
    
    ' Loop through all 56 colour indices
    For i = 1 To 56
    
        ' Apply colour to swatch cell
        ws.Cells(i + 1, 1).Interior.ColorIndex = i
        
        ' Get the long colour value
        colourLong = ws.Cells(i + 1, 1).Interior.Color
        
        ' Extract RGB components
        ' Excel stores colour as BGR not RGB so we need to reverse
        b = (colourLong \ 65536) And 255
        g = (colourLong \ 256) And 255
        r = colourLong And 255
        
        ' Build hex code
        hexCode = "#" & Right("00" & Hex(r), 2) & Right("00" & Hex(g), 2) & Right("00" & Hex(b), 2)
        
        ' Write values
        ws.Cells(i + 1, 1).Value = i
        ws.Cells(i + 1, 2).Value = UCase(hexCode)
        ws.Cells(i + 1, 3).Value = "RGB(" & r & ", " & g & ", " & b & ")"
        ws.Cells(i + 1, 4).Value = "ColorIndex = " & i
        
        ' Ensure consistent font on data rows
        With ws.Range(ws.Cells(i + 1, 1), ws.Cells(i + 1, 4))
            .Font.name = "Calibri"
            .Font.Size = 11
            .Font.Color = RGB(51, 51, 51)
            .HorizontalAlignment = xlCenter
        End With
        
        ' Make text in colour cell white or black depending on darkness
        ' so the index number is readable against the background
        If (r * 0.299 + g * 0.587 + b * 0.114) < 128 Then
            ws.Cells(i + 1, 1).Font.Color = RGB(255, 255, 255)
        Else
            ws.Cells(i + 1, 1).Font.Color = RGB(0, 0, 0)
        End If
        
    Next i
    
    ' Freeze the header row
    ws.Rows("2:2").Select
    ActiveWindow.FreezePanes = True
    ws.Cells(1, 1).Select
    
    MsgBox "Colour index map complete!" & vbCrLf & vbCrLf & _
           "56 colours mapped with hex codes and RGB values.", _
           vbInformation, "MapColorIndex"

End Sub