CODEWITHSUNDEEP
excelvba
ProgrammingStrugglesAreReal
ProgrammingStrugglesAreReal

Reputation: 3

Excel VBA - Set color based on RGB value contained another column

As part of a larger process I need to create a Excel VBA Macro that read the values from a column and applies basic formatting to the row based on the values in each cell.

The spreadsheet itself is exported from another program and opens directly in Excel. All columns come across formatted as General

The sequence is this:

  1. Start at the second row in Sheet1
  2. Look at Column J
  3. Read the RGB value (which is shown as RGB(X,Y,Z) where X, Y, and Z are the numerical values for the color that needs to be used)
  4. Change that rows text Color for Column A-I to that color
  5. Continue through all rows with text

I found this thread, but I'm not able to make it work.

Any help here much appreciated.

Upvotes: 0

Views: 916

Answers (2)

Алексей Р
Алексей Р

Reputation: 7627

Sub ColorIt()
    Set cl = Cells(2, "J")
    Do Until cl = ""
        txt = cl.Value2
        cl.Offset(, -9).Resize(, 9).Font.Color = _
            Evaluate("SUMPRODUCT({" & Mid(txt, 5, Len(txt) - 5) & "},{1,256,65536})")
        Set cl = cl.Offset(1)
    Loop
End Sub

Result:
enter image description here

Edit2

Sub ColorIt2()
    Const RGB_COL = "M"
    
    Set cl = Cells(2, RGB_COL)
    Do Until cl = ""
        txt = cl.Value2
        cl.Offset(, 1 - cl.Column).Resize(, cl.Column - 1).Interior.Color = _
            Evaluate("SUMPRODUCT({" & Mid(txt, 5, Len(txt) - 5) & "},{1,256,65536})")
        Set cl = cl.Offset(1)
    Loop
End Sub

Upvotes: 1

FaneDuru
FaneDuru

Reputation: 42236

Please, use the next function. It will convert the string in a Long color (based on the RGB three parameters. It will work for both caser of comma separators ("," and ", "):

Function ExtractRGB(strRGB As String) As Long
   Dim arr: arr = Split(Replace(strRGB, " ", ""), ",")
   ExtractRGB = RGB(CLng(Right(arr(0), Len(arr(0)) - 4)), CLng(arr(1)), CLng(left(arr(2), Len(arr(2)) - 1)))
End Function

It can be tested in the next way:

Sub TestExtractRGB()
  Dim x As String, color As Long
  x = "RGB(100,10,255)"
  x = "RGB(100, 10, 255)"
  color = ExtractRGB(x)
  Debug.Print color
  Worksheet("Sheet1").Range("A2:I2").Font.color = color
  'or directly:
  Worksheet("Sheet1").Range("A2:I2").Font.color = _
      ExtractRGB(Worksheet("Sheet1").Range("J2").value)
End Sub

If you comment x = "RGB(100, 10, 255)", it will return the same color valuem for the previous x string...

If you need to do it for all existing rows, the code must iterate from 2 to last Row and you only need to change "A2:I2" with "A" & i & ":I" & i

If necessary, I can show you how to deal with it, but I think is very simple...

Upvotes: 1

Related Questions