How to Make a Macro to Apply 3-Color Scale with Relative Cell Referencing-CodePudding

In column C I have a starting balance, in column D I have the remaining balance. I can apply a 3-color scale to that cell and make the color gradually change from green to yellow to red. The problem I am facing is I need to apply these same rules to 200 other cells, each with their own unique starting balance in column C. This prevents me from just copying the rule because Excel tells me I can not use relative cell references with these rules. To try and fix this so I do not need to click through the conditional formatting wizard 200 times, I'm trying to make a macro that applies these rules to each cell in column D. so far this is what I have.

What I am running into is that the 3-Color Scale rule is being applied to each cell, but the formula used to determine the color thresholds is not being inserted. it leaves me with this

My background in VBA is about of week of google, so forgive me if its over complicated. I used the macro recorder then changed all of the .select and .selection stuff to reference the objects directly to learn how the conditional formatting rules are initially applied.

    Dim wsT As Worksheet
 
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    Set wsT = ThisWorkbook.Worksheets("Tracking")

    For X = 5 To LastRow
    
    wsT.Range("D" & X).FormatConditions.AddColorScale ColorScaleType:=3
    wsT.Range("D" & X).FormatConditions(wsT.Range("D" & X).FormatConditions.Count).SetFirstPriority
    wsT.Range("D" & X).FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueFormula
    wsT.Range("D" & X).FormatConditions(1).ColorScaleCriteria(1).Value = _
        wsT.Range("C" & X) * 0.1
        
    With wsT.Range("D" & X).FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
    
    wsT.Range("D" & X).FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValueFormula
    wsT.Range("D" & X).FormatConditions(1).ColorScaleCriteria(2).Value = _
        wsT.Range("C" & X) * 0.65
        
    With wsT.Range("D" & X).FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    
    wsT.Range("D" & X).FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueFormula
    wsT.Range("D" & X).FormatConditions(1).ColorScaleCriteria(3).Value = _
        wsT.Range("C" & X) * 0.85
        
    With wsT.Range("D" & X).FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With
    
    Next X
    
End Sub

CodePudding user response：

My previous answer was incorrect. Your problem is that formulas need to be strings that start with =, like "=0.1*$C$1".

I wrote the following:

Sub Test()
Dim ws As Worksheet, rg As Range, cs As ColorScale
Set ws = ActiveSheet
For Each rg In ws.Range("D1", ws.Cells(ws.Rows.Count, "D").End(xlUp).Address)
   Set cs = rg.FormatConditions.AddColorScale(ColorScaleType:=3)
   cs.ColorScaleCriteria(1).Type = xlConditionValueFormula
   cs.ColorScaleCriteria(1).Value = "=0.1*$C$" & CStr(rg.Row)
   cs.ColorScaleCriteria(1).FormatColor.Color = 7039480
   cs.ColorScaleCriteria(1).FormatColor.TintAndShade = 0
   cs.ColorScaleCriteria(2).Type = xlConditionValueFormula
   cs.ColorScaleCriteria(2).Value = "=0.65*$C$" & CStr(rg.Row)
   cs.ColorScaleCriteria(2).FormatColor.Color = 8711167
   cs.ColorScaleCriteria(2).FormatColor.TintAndShade = 0
   cs.ColorScaleCriteria(3).Type = xlConditionValueFormula
   cs.ColorScaleCriteria(3).Value = "=0.85*$C$" & CStr(rg.Row)
   cs.ColorScaleCriteria(3).FormatColor.Color = 8109667
   cs.ColorScaleCriteria(3).FormatColor.TintAndShade = 0
Next rg
End Sub

Obviously, your worksheet should be set to ThisWorkbook.Worksheets("Tracking") and your beginning range should be "D5".