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

 

[Eric W]

Could you explain what you are trying to do? Do you potentially want 61 different font colors whenever something in column G changes? Do you just want the same row to change as the key? Where are the color values saved?

 

[dwhitey1124]

Could you explain what you are trying to do? Do you potentially want 61 different font colors whenever something in column G changes? Do you just want the same row to change as the key? Where are the color values saved?

If possible, I would only want the font in the same row to change. The color values are in column AS. Each row could be one of 33 colors. The color values are in ####### format. For example, Red is 5460991.

Thanks.

 

[Eric W]

How do you choose which font color you want to apply?

 

[dwhitey1124]

Each cell in column G has a dropdown of the options.

 

[Eric W]

So there's a dropdown in G8 (etc.)? What does it say? Red, green, blue, .... or a list of the number values 5460991, 1234, 4321, etc.? If it's the word, how do I match it up with the list in column AS?

 

[dwhitey1124]

Column G has red, green, blue, etc. not the numbers. The numbers for the corresponding colors are pulled in column AS using an index/match that references a table with every color available and its number.

 

[Eric W]

You can try something like this:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range, MyFont As Long
    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("G8:G59")
    
    If Application.Intersect(KeyCells, Target) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    
    MyFont = Target.Font.Color
    On Error Resume Next
    MyFont = Evaluate("VLOOKUP(" & Target.Address & ",$M$1:$N$3,2,FALSE)")
    Range("A" & Target.Row & ":I" & Target.Row).Font.Color = MyFont
    
End Sub

The key cells are in red. I didn't know exactly how you do your INDEX/MATCH, so assumed a basic VLOOKUP with the range also in red.

Let me know how this works.

 

[dwhitey1124]

You can try something like this:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range, MyFont As Long
    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("G8:G59")
    
    If Application.Intersect(KeyCells, Target) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    
    MyFont = Target.Font.Color
    On Error Resume Next
    MyFont = Evaluate("VLOOKUP(" & Target.Address & ",$M$1:$N$3,2,FALSE)")
    Range("A" & Target.Row & ":I" & Target.Row).Font.Color = MyFont
    
End Sub

The key cells are in red. I didn't know exactly how you do your INDEX/MATCH, so assumed a basic VLOOKUP with the range also in red.

Let me know how this works.

Since the font value is already in column AS, I don't think the vlookup is necessary. Is there a way to have myfont equal to the value in column AS of the target cell's row?

 

[Eric W]

Sure, try this:

Private Sub Worksheet_Change(ByVal Target As Range)
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 Application.Intersect(KeyCells, Target) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    
    Range("A" & Target.Row & ":I" & Target.Row).Font.Color = Range("AS" & Target.Row).Value
    
End Sub