Change color of text in cell based on location of active cell

[EssKayKay]

I’m looking for VBA coding that changes the text color of a cell in column C if the active cell is in column I. That is if the active cell is I44 then the text in C44 turns Red. If I cursor down to I45 then C44 text returns to Black and now C45 text turns Red.

I have this working for a different part of my worksheet. It operates very similarly (i.e., if active cell is in column M then cell in column C turns Red). Following is the code that triggers that. Please note I did not write this code – don’t remember where it came from. It's placed in "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"

   If Not Intersect(Target, Range("M32:M1300,I32:I1300")) Is Nothing Then
      Now = (Split(ActiveCell(1).Address(1, 0), "$")(1))
          If (Old <> Now) Then
             UnProtect_It          '<--- This sub Unprotects the worksheet ----
             Range(Cells(Now, 3), Cells(Now, 3)).Font.Bold = True
             If Old Then Range(Cells(Old, 3), Cells(Old, 3)).Font.Bold = False

             Range(Cells(Now, 3), Cells(Now, 3)).Font.Color = vbRed
             If Old Then Range(Cells(Old, 3), Cells(Old, 3)).Font.Color = False
             Protect_It              '<--- This sub Protects the worksheet ----
          End If
       Old = Now
   End If

Thanks for viewing,
Steve K.

 

[JoeMo]

I'm assuming your worksheet is password protected. If that's not the case then remove the the two lines that require your password.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Me.Unprotect Password:=""  'Put your password between the quote marks
Target = Target(1)
If Not Intersect(Target, Range("I:I")) Is Nothing Then
    Range("C:C").Font.Color = vbBlack
    Cells(Target.Row, "C").Font.Color = vbRed
End If
Me.Protect Password:="" 'Put your password between the quote marks
End Sub

 

[EssKayKay]

I'm assuming your worksheet is password protected. If that's not the case then remove the the two lines that require your password.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Me.Unprotect Password:=""  'Put your password between the quote marks
Target = Target(1)
If Not Intersect(Target, Range("I:I")) Is Nothing Then
    Range("C:C").Font.Color = vbBlack
    Cells(Target.Row, "C").Font.Color = vbRed
End If
Me.Protect Password:="" 'Put your password between the quote marks
End Sub

Thank you very much Joe for your concern and quick response. The worksheet is not PW protected but I think I found my problem. There is another line of code in the Worksheet_SelectinChange sub that read "If Intersect(Target, Range("M:M")) Is Nothing Then Exit Sub" which I forgot to note (my bad - sorry). What I did was added "I:I" to the code so it now reads "If Intersect(Target, Range("M:M,I:I")) Is Nothing Then Exit Sub". It appears to be working but I will have to do more testing.

Again, thank you Joe - much appreciated.