Adding If statement to conditional formatting VBA macro

Question

I have a macro that conditionally formats cells in a column with colors biased on contained keywords then reports the used keywords and corresponding colors to another sheet.

What I'm trying to do is add an if statement (or something like it) to reference another cell and only format the cell if the corrosponding cell contains a value greater than or = to .6 lets say im wanting to reference cells in column "D"

So when it is working it should check for a keyword in a cell in column "F" then check column "D" to see if it has a value greater than or = to .6 and if both conditions are met than it will color code the cell in column "F"

Here it is:

Sub ColorCodingPluskey()
'
' ColorCodingPluskey Macro
'

    Dim wb As Workbook
    Dim wsKey As Worksheet
    Dim wsFees As Worksheet
    Dim aKeyColors(1 To 20, 1 To 2) As Variant
    Dim aOutput() As Variant
    Dim sKeyShName As String
    Dim i As Long, j As Long

    Set wb = ActiveWorkbook
    Set wsFees = wb.Sheets("Fees")
    sKeyShName = "Color Coding Key"

    On Error Resume Next
    Set wsKey = wb.Sheets(sKeyShName)
    On Error GoTo 0
    If wsKey Is Nothing Then
        Set wsKey = wb.Sheets.Add(After:=ActiveSheet)
        wsKey.Name = sKeyShName
        With wsKey.Range("A1:B1")
            .Value = Array("Word", "Color")
            .HorizontalAlignment = xlCenter
            .Font.Bold = True
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
        End With
    Else
        wsKey.Range("A2:B" & wsKey.Rows.Count).Clear
    End If

    aKeyColors(1, 1) = "Strategize":    aKeyColors(1, 2) = 10053120
    aKeyColors(2, 1) = "Coordinate":    aKeyColors(2, 2) = 13421619
    aKeyColors(3, 1) = "Committee":     aKeyColors(3, 2) = 16777062
    aKeyColors(4, 1) = "Attention":     aKeyColors(4, 2) = 2162853
    aKeyColors(5, 1) = "Work":          aKeyColors(5, 2) = 5263615
    aKeyColors(6, 1) = "Circulate":     aKeyColors(6, 2) = 10066431
    aKeyColors(7, 1) = "Numerous":      aKeyColors(7, 2) = 13158
    aKeyColors(8, 1) = "Follow up":     aKeyColors(8, 2) = 39372
    aKeyColors(9, 1) = "Attend":        aKeyColors(9, 2) = 65535
    aKeyColors(10, 1) = "Attention to": aKeyColors(10, 2) = 65535
    aKeyColors(11, 1) = "Print":        aKeyColors(11, 2) = 10092543
    aKeyColors(12, 1) = "WIP":          aKeyColors(12, 2) = 13056
    aKeyColors(13, 1) = "Prepare":      aKeyColors(13, 2) = 32768
    aKeyColors(14, 1) = "Develop":      aKeyColors(14, 2) = 3394611
    aKeyColors(15, 1) = "Participate":  aKeyColors(15, 2) = 10092441
    aKeyColors(16, 1) = "Organize":     aKeyColors(16, 2) = 13369548
    aKeyColors(17, 1) = "Various":      aKeyColors(17, 2) = 16751103
    aKeyColors(18, 1) = "Maintain":     aKeyColors(18, 2) = 16724787
    aKeyColors(19, 1) = "Team":         aKeyColors(19, 2) = 16750950
    aKeyColors(20, 1) = "Address":      aKeyColors(20, 2) = 6697881

    wsFees.Cells.FormatConditions.Delete
    ReDim aOutput(1 To UBound(aKeyColors, 1), 1 To 2)
    With wsFees.Columns("F")
        For i = LBound(aKeyColors, 1) To UBound(aKeyColors, 1)
            If WorksheetFunction.CountIf(.Cells, "*" & aKeyColors(i, 1) &"*") > 0 Then
                j = j + 1
                aOutput(j, 1) = aKeyColors(i, 1)
                aOutput(j, 2) = aKeyColors(i, 2)
                .FormatConditions.Add xlTextString, String:=aKeyColors(i, 1), TextOperator:=xlContains
                .FormatConditions(.FormatConditions.Count).Interior.Color = aKeyColors(i, 2)
            End If
        Next i
    End With

    If j > 0 Then
        wsKey.Range("A2").Resize(j, 1).Value = aOutput
    For i = 1 To j
            wsKey.Cells(i + 1, "B").Interior.Color = aOutput(i, 2)
        Next i
        wsKey.Columns("A").EntireColumn.AutoFit
    End If

End Sub

Any help is greatly appreciated, Thanks!

SJR · Accepted Answer · 2018-06-14 23:29:05Z

1

Here I have just changed the format conditions to a formula so that it checks the value in D and whether the text is found in F. Let me know how you get on.

For i = LBound(aKeyColors, 1) To UBound(aKeyColors, 1)
     If WorksheetFunction.CountIf(.Cells, "*" & aKeyColors(i, 1) & "*") > 0 Then
          j = j + 1
          aOutput(j, 1) = aKeyColors(i, 1)
          aOutput(j, 2) = aKeyColors(i, 2)
          .FormatConditions.Add xlExpression, Formula1:="=AND(D1>0.6,ISNUMBER(FIND(""" & aKeyColors(i, 1) & """,F1)))"
          .FormatConditions(.FormatConditions.Count).Interior.Color = aKeyColors(i, 2)
     End If
Next i

answered Jun 14, 2018 at 23:29

SJR

23.1k6 gold badges21 silver badges26 bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

Hayden Shirts Over a year ago

That seems to have done the trick, thanks for the assistance!

Hayden Shirts Over a year ago

although that seems to have worked, there does seem to be a problem that was not in the previous version. In the previous versions the macro the keywords were not case sensitive but with this change they have become case sensitive and the cell is only formatted when the word appears with the first letter being capital and all others being lower case TLDR: with chage to macro "Coordinate" works but "coordinate" does not. It did prior to the change.

chris neilsen Over a year ago

@Hayden FIND is case sensitive, you can use SEARCH instead, not case sensitive, ie Formula1:="=AND(D1>0.6,ISNUMBER(SEARCH(...

Collectives™ on Stack Overflow

Adding If statement to conditional formatting VBA macro

1 Answer 1

3 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

3 Comments

Your Answer

Sign up or log in

Post as a guest

Related