Excel Conditional Formatting a Table on a Color Scale (Red:Yellow:Green:Yellow:Red)

I will preface this with I'm fairly new at VBA and coding in general. I'm trying to create a Macro that will look at a table and apply a color scale based on hours worked. Ideally red to yellow to green for 0 to 7.5 and then green to yellow to red going over that amount. I got one form of code to work, but it only works on one cell at a time.

Sub HourColorsShortOneCell()
    Dim rg, cl As Range
    Dim col, row As Integer
    Dim cs As ColorScale
 
    Set rg = Selection

    If rg.Value < 3.75 Then
        Set cs = rg.FormatConditions.AddColorScale(ColorScaleType:=3)
            cs.ColorScaleCriteria(1).Type = xlConditionValueFormula
            cs.ColorScaleCriteria(1).Value = "0"
            cs.ColorScaleCriteria(1).FormatColor.Color = RGB(255, 0, 0)
            cs.ColorScaleCriteria(1).FormatColor.TintAndShade = 0
            cs.ColorScaleCriteria(2).Type = xlConditionValueFormula
            cs.ColorScaleCriteria(2).Value = "3.75"
            cs.ColorScaleCriteria(2).FormatColor.Color = RGB(255, 255, 0)
            cs.ColorScaleCriteria(2).FormatColor.TintAndShade = 0
    ElseIf rg.Value >= 3.75 And rg.Vale <= 11.25 Then
        Set cs = rg.FormatConditions.AddColorScale(ColorScaleType:=3)
            cs.ColorScaleCriteria(1).Type = xlConditionValueFormula
            cs.ColorScaleCriteria(1).Value = "3.75"
            cs.ColorScaleCriteria(1).FormatColor.Color = RGB(255, 255, 0)
            cs.ColorScaleCriteria(1).FormatColor.TintAndShade = 0
            cs.ColorScaleCriteria(2).Type = xlConditionValueFormula
            cs.ColorScaleCriteria(2).Value = "7.5"
            cs.ColorScaleCriteria(2).FormatColor.Color = RGB(0, 255, 0)
            cs.ColorScaleCriteria(2).FormatColor.TintAndShade = 0
            cs.ColorScaleCriteria(3).Type = xlConditionValueFormula
            cs.ColorScaleCriteria(3).Value = "11.25"
            cs.ColorScaleCriteria(3).FormatColor.Color = RGB(255, 255, 0)
            cs.ColorScaleCriteria(3).FormatColor.TintAndShade = 0
    ElseIf rg.Value < 11.25 Then
        Set cs = rg.FormatConditions.AddColorScale(ColorScaleType:=3)
            cs.ColorScaleCriteria(1).Type = xlConditionValueFormula
            cs.ColorScaleCriteria(1).Value = "11.25"
            cs.ColorScaleCriteria(1).FormatColor.Color = RGB(255, 255, 0)
            cs.ColorScaleCriteria(1).FormatColor.TintAndShade = 0
            cs.ColorScaleCriteria(2).Type = xlConditionValueFormula
            cs.ColorScaleCriteria(2).Value = "15"
            cs.ColorScaleCriteria(2).FormatColor.Color = RGB(255, 0, 0)
            cs.ColorScaleCriteria(2).FormatColor.TintAndShade = 0
    End If

End Sub

Then I kinda gave up with the coloration and went with red to green to red. But I still want to figure this issue out.

Sub HourColorsShort()
    Dim rg, cl As Range
    Dim col, row As Integer
    Dim cs As ColorScale
 
    Set rg = Selection


    Set cs = rg.FormatConditions.AddColorScale(ColorScaleType:=3)
        cs.ColorScaleCriteria(1).Type = xlConditionValueFormula
        cs.ColorScaleCriteria(1).Value = "0"
        cs.ColorScaleCriteria(1).FormatColor.Color = RGB(255, 0, 0)
        cs.ColorScaleCriteria(1).FormatColor.TintAndShade = 0
        cs.ColorScaleCriteria(2).Type = xlConditionValueFormula
        cs.ColorScaleCriteria(2).Value = "7.5"
        cs.ColorScaleCriteria(2).FormatColor.Color = RGB(0, 255, 0)
        cs.ColorScaleCriteria(2).FormatColor.TintAndShade = 0
        cs.ColorScaleCriteria(3).Type = xlConditionValueFormula
        cs.ColorScaleCriteria(3).Value = "15"
        cs.ColorScaleCriteria(3).FormatColor.Color = RGB(255, 0, 0)
        cs.ColorScaleCriteria(3).FormatColor.TintAndShade = 0


End Sub

Here's an example of the current situation. Red to Green to Red

Edit: I forgot to update the colors in the code. (Fixed)

Solution

Edited - couple minor fixes in the CF-based approach, and added a non-CF version, which I think is cleaner/easier to apply.

Here's a refactored version of your first example (edited after your answer, to fix the parts I'd missed):

Sub HourColorsShortOneCell()
    Dim rg As Range, cl As Range, v
    
    Set rg = Selection
    rg.FormatConditions.Delete
    
    For Each cl In rg.Cells   'check each cell
        v = cl.Value
        If IsNumeric(v) Then  'numeric value?
            If v < 3.75 Then
                SetCF cl, Array(0, vbRed, 3.75, vbYellow)
            ElseIf v >= 3.75 And v <= 11.25 Then
                SetCF cl, Array(3.75, vbYellow, 7.5, vbGreen, 11.25, vbYellow)
            ElseIf v > 11.25 Then
                SetCF cl, Array(11.25, vbYellow, 15, vbRed)
            End If
        End If
    Next cl
End Sub

'apply a CF type 2 or 3 to cell `c`, using limit and color information in array `arr`
Sub SetCF(c As Range, arr)
    Dim i As Long, n As Long, typ
    '<todo> Add some code to check unbound of `arr` is either 3 or 5...
    typ = IIf(UBound(arr) = 3, 2, 3) 'how many ranges are we adding?
                                     '   set type accordingly
    With c.FormatConditions.AddColorScale(ColorScaleType:=typ)
        For i = 0 To UBound(arr) Step 2
            n = n + 1
            With .ColorScaleCriteria(n)
                .Type = xlConditionValueNumber '<<< no need to quote the cutoffs
                .Value = arr(i)
                .FormatColor.Color = arr(i + 1)
                .FormatColor.TintAndShade = 0
            End With
        Next i
    End With
End Sub

Example result:

Alternate approach
Here's how you can do this without using CF. Since in this case your values are static, the coloring only needs to be applied once, and you can interpolate between RGB colors without needing to use CF to do that...

Sub Tester()

    Dim fmt
    
    'start coloring values at 0 with red, transition to yellow by 4.75, then
    '  to green by 9.5, finally to red by 19
    fmt = Array(0, vbRed, 4.75, vbYellow, 9.5, vbGreen, 14.25, vbYellow, 19, vbRed)
    ApplyColorFormat [D3:H23], fmt
    
    Stop 'pause here to admire the result...
    
    'transition from white to red for any values between 10 and 20
    fmt = Array(10, vbWhite, 20, vbRed)
    ApplyColorFormat [D3:H23], fmt

End Sub

'----------# reusable code below here #-----------

'apply a color scale defined in `fmt` to each cell in range `rng`
'  `fmt` is array of (value1, color1, value2, color2, ....., valueN, colorN)
Sub ApplyColorFormat(rng As Range, fmt)
    Dim arr() As Long, c As Range, clr As Long, i As Long, v
    
    For i = LBound(fmt) + 1 To UBound(fmt) Step 2
        fmt(i) = ColorParts(CLng(fmt(i))) 'split each format color to its parts
                                          'only need to do this once...
    Next i
    rng.Interior.ColorIndex = xlNone 'remove any existing color fill
    For Each c In rng.Cells
        v = c.Value
        If Len(v) > 0 And IsNumeric(v) Then 'colorable?
            For i = LBound(fmt) To UBound(fmt) - 2 Step 2
                clr = InterpColor(v, fmt(i), fmt(i + 2), fmt(i + 1), fmt(i + 3))
                If clr > -1 Then  'if value was in range, apply color and stop checking
                    c.Interior.Color = clr
                    Exit For
                End If
            Next i
        End If
    Next c
End Sub

'If value `v` lies between `vMin` and `vMax`, return a color
'   which is between `clrArr1` and `clrArr2`
'   [colors are represented as Long(1 to 3) arrays of R,G,B values]
'If value is outside of the range, return -1
Function InterpColor(v, vMin, vMax, clrArr1, clrArr2) As Long
    Dim i As Long, rv As Long, p1 As Long, p2 As Long, pf As Long
    Dim arrout(1 To 3) As Long
    
    If v < vMin Or v > vMax Then
        InterpColor = -1 'no action: value is out of range
    Else
        'in range: figure out the appropriate color
        For i = 1 To 3
            p1 = clrArr1(i)
            p2 = clrArr2(i)
            If p1 <> p2 Then
                pf = p1 + ((v - vMin) / (vMax - vMin)) * (p2 - p1)
                arrout(i) = pf
            Else
                arrout(i) = p1
            End If
        Next i
        'Debug.Print "v=" & v, arrout(1), arrout(2), arrout(3)
        InterpColor = RGB(arrout(1), arrout(2), arrout(3))
    End If
End Function

'split an RGB color to an array its R,G,B parts
Function ColorParts(clr As Long) As Long()
    Dim parts(1 To 3) As Long
    parts(1) = CLng(clr Mod 256)
    parts(2) = CLng(((clr - parts(1)) / 256) Mod 256)
    parts(3) = CLng(((clr - parts(1) - (parts(2) * 256)) / 256 / 256) Mod 256)
    ColorParts = parts
End Function

Examples from Tester: