Hi Gary,

So this list of values changes?
Will it always be A1, B1, C1 and down without spaces?

If you select the first cell and then run
  Range(Selection, Selection.End(xlDown)).Select
this does the same as Ctrl + Shift + Down highlighting every cell until there are no more with content in them.
Now you can use a loop that goes through each cell and store the value.

Here's some code to get you started:

Sub Macro16()

    Dim Colours() As String ' declares a dynamic array variable
    
    Range(Selection, Selection.End(xlDown)).Select
    NoOfCells = Selection.Count
    
    ReDim Colours(1 To NoOfCells) ' declares the array variable with the necessary size
    
    lCount = 1
    For Each CurCell In Selection
        Colours(lCount) = CurCell.Interior.ColorIndex
        lCount = lCount + 1
    Next CurCell
    
    For Each Colour In Colours()
        MsgBox Colour
    Next Colour
    
End Sub

Try repeating the code with the column of case statements then you can join the two arrays assigning the colours to cases...

Regards
Alex