Help Cleaning up Font.Color Keycells Macro

[dwhitey1124]

Hi all,
I'm trying to change the font color in a range when the cell in column G changes. The macro below is only working for the first row (row 8). I imagine this would be easier as a loop but I couldn't figure it out. There are many different font colors and each cell already has extensive conditional formatting so I would like to stick to a macro for this.

Any help would be much appreciated.

Thanks.

Dave

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.ScreenUpdating = False
     
Dim KeyCells As Range
    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("G8:G59")
    
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
           
Range("A8:I8").Font.Color = Range("AS8").Value
Range("A9:I9").Font.Color = Range("AS9").Value
Range("A10:I10").Font.Color = Range("AS10").Value
Range("A11:I11").Font.Color = Range("AS11").Value
Range("A12:I12").Font.Color = Range("AS12").Value
Range("A13:I13").Font.Color = Range("AS13").Value
Range("A14:I14").Font.Color = Range("AS14").Value
Range("A15:I15").Font.Color = Range("AS15").Value
Range("A16:I16").Font.Color = Range("AS16").Value
Range("A17:I17").Font.Color = Range("AS17").Value
Range("A18:I18").Font.Color = Range("AS18").Value
Range("A19:I19").Font.Color = Range("AS19").Value
Range("A20:I20").Font.Color = Range("AS20").Value
Range("A21:I21").Font.Color = Range("AS21").Value
Range("A22:I22").Font.Color = Range("AS22").Value
Range("A23:I23").Font.Color = Range("AS23").Value
Range("A24:I24").Font.Color = Range("AS24").Value
Range("A25:I25").Font.Color = Range("AS25").Value
Range("A26:I26").Font.Color = Range("AS26").Value
Range("A27:I27").Font.Color = Range("AS27").Value
Range("A28:I28").Font.Color = Range("AS28").Value
Range("A29:I29").Font.Color = Range("AS29").Value
Range("A30:I30").Font.Color = Range("AS30").Value
Range("A31:I31").Font.Color = Range("AS31").Value
Range("A32:I32").Font.Color = Range("AS32").Value
Range("A33:I33").Font.Color = Range("AS33").Value
Range("A34:I34").Font.Color = Range("AS34").Value
Range("A35:I35").Font.Color = Range("AS35").Value
Range("A36:I36").Font.Color = Range("AS36").Value
Range("A37:I37").Font.Color = Range("AS37").Value
Range("A38:I38").Font.Color = Range("AS38").Value
Range("A39:I39").Font.Color = Range("AS39").Value
Range("A40:I40").Font.Color = Range("AS40").Value
Range("A41:I41").Font.Color = Range("AS41").Value
Range("A42:I42").Font.Color = Range("AS42").Value
Range("A43:I43").Font.Color = Range("AS43").Value
Range("A44:I44").Font.Color = Range("AS44").Value
Range("A45:I45").Font.Color = Range("AS45").Value
Range("A46:I46").Font.Color = Range("AS46").Value
Range("A47:I47").Font.Color = Range("AS47").Value
Range("A48:I48").Font.Color = Range("AS48").Value
Range("A49:I49").Font.Color = Range("AS49").Value
Range("A50:I50").Font.Color = Range("AS50").Value
Range("A51:I51").Font.Color = Range("AS51").Value
Range("A52:I52").Font.Color = Range("AS52").Value
Range("A53:I53").Font.Color = Range("AS53").Value
Range("A54:I54").Font.Color = Range("AS54").Value
Range("A55:I55").Font.Color = Range("AS55").Value
Range("A56:I56").Font.Color = Range("AS56").Value
Range("A57:I57").Font.Color = Range("AS57").Value
Range("A59:I59").Font.Color = Range("AS59").Value
Range("A60:I60").Font.Color = Range("AS60").Value
Range("A61:I61").Font.Color = Range("AS61").Value
Range("A62:I62").Font.Color = Range("AS62").Value
Range("A63:I63").Font.Color = Range("AS63").Value
Range("A64:I64").Font.Color = Range("AS64").Value
Range("A65:I65").Font.Color = Range("AS65").Value
Range("A66:I66").Font.Color = Range("AS66").Value
Range("A67:I67").Font.Color = Range("AS67").Value
Range("A68:I68").Font.Color = Range("AS68").Value
Application.ScreenUpdating = True
End If
End Sub

 

[dwhitey1124]

I tweaked it a bit and it seems to be working. Thanks for figuring this out.

Private Sub Worksheet_Change(ByVal Target As Range)'On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = True


 Dim KeyCells As Range
    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("G8:G68")
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
    
        Range("A" & Target.Row & ":I" & Target.Row).Font.Color = Range("AS" & Target.Row).Value
    
Application.ScreenUpdating = True


End If


End Sub

 

[Eric W]

You're welcome.

 

[dwhitey1124]

I'm having issues when copying down the selected color. How would you modify the macro so that it changes colors for the whole range when a cell is changed?