Excel VBA to color match cells

[Mark39841]

hello everyone. I wasn't able to locate the answer that I need from previous posts so here's my problem: our system automatically generates a large data spreadsheet and the problem lies in one column. That column contains dates & has specific colour to identify what the date is for (see attached image). Column A contains cells with dates and each one has a specific colour coding. Color coding names are indicated in Column E. The moment I insert a new column (Column B), Excel will also copy Column A's cell formatting. However, I need Excel to also identify each cell's colour to correspond its color name. So if a date in Column A has a cell colour of peach, Peach Colour will be identified as "Tentative" in Column B. I tried to use conditional formatting to it but it didn't help. I hope VBA can do this but I don't have any clue since I'm not a programmer. Can somebody help me on this? If you guys can provide me a VBA code that I can easily follow/edit, maybe use RGB values to be specific or anything.

 

[igold]

Hi Mark39841, welcome to the MrExcel forum. Does this get you close to what you need. Put your RGB values where I indicated for the text that is on the next line of code, so the first RGB code you enter will refer to the color for "Tentative".

Sub NameColor()

    Dim rng As Range, cel As Range
    
    Application.ScreenUpdating = False
    Set rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    For Each cel In rng
        Select Case cel.Interior.Color
            Case Is = RGB(218, 233, 248)    'Put your RGB color here
                cel.Offset(, 1).Value = "Tentative"
            Case Is = RGB(131, 226, 142)    'Put your RGB color here
                cel.Offset(, 1).Value = "Confirmed"
            Case Is = RGB(247, 199, 172)    ''Put your RGB color here
                cel.Offset(, 1).Value = "No"
            Case Is = RGB(255, 0, 0)    'Put your RGB color here
                cel.Offset(, 1).Value = "Done"
            Case Is = RGB(191, 191, 191)    'Put your RGB color here
                cel.Offset(, 1).Value = "Current"
        End Select
    Next
    Application.ScreenUpdating = True
    
End Sub

 

[Mark39841]

thank you for responding! I would need to test this out at work since I don't have access to our systems at home and I'll post my results here by the time as soon as possible.

 

[Mark39841]

hi i gold! I tried... but it didn't work. Since I'm not able to get a copy of that spreadsheet outside company premises, I re-created it at home.

5.56 MB file on MEGA

mega.nz

I have copieed the code you gave and inputted the RGB values of the colored cells, but after I saved and exit Macros table and insert a new column beside Column A, nothing happens, it just copied the cells formatting. or do I need to do something else here?

 

[Mark39841]

oh by the way, here's my excel template that I've created for this containing the code you gave:

13.3 KB file on MEGA

mega.nz

 

[Fuji]

try

Sub NameColor()
    Dim r As Range, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    For Each r In Range("h2", Range("h" & Rows.Count).End(xlUp))
        dic(r(, 0).Interior.Color) = Application.Trim(Replace(r, "=", ""))
    Next
    For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp)).Columns(2).Cells
        r.Value = dic(r.Interior.Color)
    Next
    Application.ScreenUpdating = True
End Sub

 

[igold]

The code works, the problem is that you are not triggering it. A lot of people will write code using the worksheet change event as a trigger. This code will trigger if you Double-Click Cell "B1" after you insert your column. The only thing you have to is to place the code in the "Sheet1" module which is right under the "Microsoft Excel Objects" heading above your Module1 where the code currently resides. The following code has been changed to trigger on the Double-Click. To repeat, the code must be placed in the "Sheet1" module.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim rng As Range, cel As Range

    If Target = Range("B1") Then
        Application.ScreenUpdating = False
        Set rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        For Each cel In rng
            Select Case cel.Interior.Color
                Case Is = RGB(255, 218, 185)    'Put your RGB color here
                    cel.Offset(, 1).Value = "Tentative"
                Case Is = RGB(173, 216, 230)    'Put your RGB color here
                    cel.Offset(, 1).Value = "Confirmed"
                Case Is = RGB(255, 255, 255)    'Put your RGB color here
                    cel.Offset(, 1).Value = "No"
                Case Is = RGB(169, 169, 169)    'Put your RGB color here
                    cel.Offset(, 1).Value = "Done"
                Case Is = RGB(0, 100, 0)    'Put your RGB color here
                    cel.Offset(, 1).Value = "Current"
            End Select
        Next
    End If
    Application.ScreenUpdating = True
    
End Sub

 

[Mark39841]

yey! it works! now I can continue to automate my tasks. thank you so much for all your help wizards!