Formatting value of cells based on color

[kmmsquared]

Hello,

I am new to VBA, and I am looking to select a column and format the cells based on their back fill color. I have three conditions.

The information regarding the first color is below, and the contents of the cell should be 1 if this condition is true in column D:

.PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.799981688894314

The information regarding the second color is below, and the contents of the cell should be 2 if this condition is true in column D:

.PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.599963377788629

Finally, the information regarding the third color is below, and the contents of the cell should be 3 if this condition is true in column D

 .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599963377788629

Any help would be greatly appreciated!

 

[Jerry Sullivan]

Hi,

Since the ThemeColor is unique for each of the three cases, you could test whether each cell has xlThemeColorAccent4, 5 , or 6. If True, test for the other 2 properties.

This should work....

Sub MyCF()
    Dim c As Range
 
    For Each c In Sheets("Sheet1").Range("B1:B100")
        With c.Interior
            Select Case .ThemeColor
                Case xlThemeColorAccent4
                    If .PatternColorIndex = xlAutomatic And _
                        .TintAndShade = 0.799951170384838 Then
                        c.value = 1
                    End If
                Case xlThemeColorAccent5
                      If .PatternColorIndex = xlAutomatic And _
                        .TintAndShade = 0.599963377788629 Then
                            c.value = 2
                    End If
                Case xlThemeColorAccent6
                    If .PatternColorIndex = xlAutomatic And _
                        .TintAndShade = 0.599963377788629 Then
                            c.value = 3
                    End If
                Case Else
                    'c.value = ?
            End Select
        End With
    Next c
End Sub

I say it should work, because I found in testing this that you can't set the .TintAndShade to the 15 decimal place level of precision you specified. So the code above will do what you asked, but will always test false- no matches so it isn't very useful as is.

Therefore, you could test this with some lesser level of precision, or modify your criteria to only compare the property rounded to a few decimal places.

If .PatternColorIndex = xlAutomatic And _
   Round(.TintAndShade, 4) = Round(0.599963377788629, 4) Then

Good luck!