Set automatic TEXT and BACKGROUND colors depending on unique HEX values in separate columns?

How could the below code be modified to create 3 columns such that column A contains unique HEX codes representing text colors (each cell in column A would contain the HEX code displayed in the respective color of the code in the same cell against the same cell's default background color), column B contains unique HEX codes representing background colors (each cell in column B would contain the HEX code displayed in the same cell's default text color against the background color represented by the same cell's HEX code) and column C takes any text inputted into any cell in column C and displays it such that the text color represents the same cell's row's HEX value found in column A and the background color represents the same cell's row's HEX value found in column B?

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo bm_Safe_Exit
    Application.EnableEvents = False
    Dim rng As Range, clr As String
    For Each rng In Target
        If IsEmpty(rng.Value2) Then
            rng.Interior.Color = xlNone
        ElseIf Trim(rng.Value2) = "" Then
            rng.Interior.Color = xlNone
        ElseIf Left(rng.Value2, 1) = "#" And Len(rng.Value2) = 7 Then
            clr = Right(Range("A1").Value2, 6)
            rng.Interior.Color = RGB(Application.Hex2Dec(Left(clr, 2)), Application.Hex2Dec(Mid(clr, 3, 2)), Application.Hex2Dec(Right(clr, 2)))
            clr = Right(Range("B1").Value2, 6)
            rng.Characters.Font.Color = RGB(Application.Hex2Dec(Left(clr, 2)), Application.Hex2Dec(Mid(clr, 3, 2)), Application.Hex2Dec(Right(clr, 2)))
        End If
    Next rng

bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

Well, for kicks, I decided to submit this same query to Microsoft's free AI called Co-Pilot built into their free Edge browser. Surprisingly, it came back with a response that closely solved my issue. I told it the correction I needed, and it resolved the small outstanding issue. I am finally impressed with their AI. In any case here is the solution it gave me for anyone else in need of a similar solution...

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo bm_Safe_Exit
    Application.EnableEvents = False
    Dim rng As Range, textColor As String, bgColor As String
    
    For Each rng In Target
        If rng.Column = 1 Then ' Column A
            If Left(rng.Value2, 1) = "#" And Len(rng.Value2) = 7 Then
                textColor = Right(rng.Value2, 6)
                rng.Font.Color = RGB(Application.Hex2Dec(Left(textColor, 2)), Application.Hex2Dec(Mid(textColor, 3, 2)), Application.Hex2Dec(Right(textColor, 2)))
                rng.Interior.Color = xlNone ' Ensure background is default
            End If
        ElseIf rng.Column = 2 Then ' Column B
            If Left(rng.Value2, 1) = "#" And Len(rng.Value2) = 7 Then
                bgColor = Right(rng.Value2, 6)
                rng.Interior.Color = RGB(Application.Hex2Dec(Left(bgColor, 2)), Application.Hex2Dec(Mid(bgColor, 3, 2)), Application.Hex2Dec(Right(bgColor, 2)))
                rng.Font.ColorIndex = xlAutomatic ' Ensure text is default
            End If
        ElseIf rng.Column = 3 Then ' Column C
            If Cells(rng.Row, 1).Value2 <> "" And Cells(rng.Row, 2).Value2 <> "" Then
                textColor = Right(Cells(rng.Row, 1).Value2, 6)
                bgColor = Right(Cells(rng.Row, 2).Value2, 6)
                rng.Font.Color = RGB(Application.Hex2Dec(Left(textColor, 2)), Application.Hex2Dec(Mid(textColor, 3, 2)), Application.Hex2Dec(Right(textColor, 2)))
                rng.Interior.Color = RGB(Application.Hex2Dec(Left(bgColor, 2)), Application.Hex2Dec(Mid(bgColor, 3, 2)), Application.Hex2Dec(Right(bgColor, 2)))
            End If
        End If
    Next rng

bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

Recommended topics

Hot tags