Macro to replace conditional formatting based on letters entered into cells.

i need a macro to perform the function of conditional formatting.  I want to upload our work rota to google docs, but the conditional formatting i've used isn't supported by google.

I currently have conditions to say if the letter H is added to a cell the cell changes to have a yellow background, or S to change the cell to have a red background. The rota is comprised of 12 worksheets filling A1:AF39.  I need this in a macro.

The best i could do was a loop to change all the specific cells based on 1 row.  I want to to scan all the rows in each worksheet and maybe update them on saving the spreadsheet.

The closest i got only works on the column C and leaves the rest unformatted:

Sub Update_Row_Colors()

    Dim LRow As Integer
    Dim LCell As String
    Dim LColorCells As String
    'Start at row 7
    LRow = 7

    'Update row colors for the first 39 rows
    While LRow < 39
        LCell = "C" & LRow
        'Color will changed in columns A to K
        LColorCells = "A" & LRow & ":" & "K" & LRow

        Select Case Left(Range(LCell).Value, 6)

            'Set row color to light blue
            Case "F"
                Range(LColorCells).Interior.ColorIndex = 34
                Range(LColorCells).Interior.Pattern = xlSolid

            'Set row color to light green
            Case "S"
                Rows(LRow & ":" & LRow).Select
                Range(LColorCells).Interior.ColorIndex = 35
                Range(LColorCells).Interior.Pattern = xlSolid

            'Set row color to light yellow
            Case "H"
                Rows(LRow & ":" & LRow).Select
                Range(LColorCells).Interior.ColorIndex = 19
                Range(LColorCells).Interior.Pattern = xlSolid

            'Default all other rows to no color
            Case Else
                Rows(LRow & ":" & LRow).Select
                Range(LColorCells).Interior.ColorIndex = xlNone

        End Select

        LRow = LRow + 1
    Wend

    Range("A1").Select

End Sub
Start Free Trial