Excel VBA Change text colour depending on another cell's content

[JELL]

I have absolutely no experience in VBA;

I am using Excel 2002 and have a spreadsheet comprising columns A – AM and rows 1-900

Entries in column O can be C, N, RC, RN

I have been trying to write a code so that –

If Columns O = C and J is a date in the future, then Column C will automatically be populated with “CW” and the whole of the row will be in dark green text

If Columns O = “C” and J is today or a date in the past, then Column C will automatically be populated with “C” and the whole of the row will be in red text

If Columns O = “N” and P is blank, then Column C will automatically be populated with “W” and the whole of the row will be in dark blue text

If Columns O = “N” and P has a date in it, then Column C will automatically be populated with “E” and the whole of the row will be in black text

If Columns O = “RC” or “RN” and L is blank, then Column C will automatically be populated with “W” and the whole of the row will be in dark blue text

If Columns O = “RC” and L has a date in it, then Column C will automatically be populated with “C” and the whole of the row will be in red text

If Columns O = “RN” and L has a date in it, then Column C will automatically be populated with “E” and the whole of the row will be in black text

Any other entries should default to black text

All of the above to be non-case sensitive.

I’ve managed, almost, to get this to work using an IFAND function and conditional formatting but would rather use VBA because this would prevent any other users from meddling with the functionality.

Lastly can anyone suggest a good site for gaining an understanding of how to write VBA procedures, one that will explain things as if I am a simpleton and use words of not more than 2 syllables

Appreciate any suggestions

[Philcjr]

Jell,

Welcome to the board... here is what I put together and seems to meet your needs. I am sure there are other ways, but remember with VBA there are many ways to aproach something and still get the same result.

I wrote this with the idea that you would key in all your information and then key in your values in Column O last... once you change something in Column O, the code will exicute. If you want this, right-click your sheet tab and paste this code.

[vba]
Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Range("O:O"), Target) Is Nothing Then Exit Sub

Dim X As Long
Dim LastRow As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

'Clear Column C and set all cells to have a Blank Font
With Columns("C")
.Clear
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 1 'Black
End With

'Define what the last row is by looking in Col O
Let LastRow = Range("O" & Rows.Count).End(xlUp).Row

'Loop through from Row 1 to the LastRow
For X = 1 To LastRow
If IsEmpty(Cells(X, 15)) Then GoTo ExitEary
With Cells(X, 15)
Select Case UCase(.Value)
Case "C"
With Cells(X, 10) 'Col J
If IsDate(.Value) And .Value > Now() Then
With Cells(X, 3)
.Value = "CW"
.Font.ColorIndex = 10 'Dark Green
End With
ElseIf IsDate(.Value) And .Value <= Now() Then
With Cells(X, 3)
.Value = "C"
.Font.ColorIndex = 3 'Red
End With
End If
End With
Case "N"
With Cells(X, 16) 'Col P
If IsEmpty(Cells(X, 16)) Then
With Cells(X, 3)
.Value = "W"
.Font.ColorIndex = 5 'Blue
End With
ElseIf IsDate(.Value) Then
With Cells(X, 3)
.Value = "E"
.Font.ColorIndex = 1 'Black
End With
End If
End With
Case "RC"
If IsEmpty(Cells(X, 12).Value) = True Then 'Col L
With Cells(X, 3)
.Value = "W"
.Font.ColorIndex = 5 'Blue
End With
ElseIf IsDate(Cells(X, 12).Value) = True Then 'Col L
With Cells(X, 3)
.Value = "C"
.Font.ColorIndex = 3 'Red
End With
End If
Case "RN"
If IsEmpty(Cells(X, 12).Value) = True Then 'Col L
With Cells(X, 3)
.Value = "W"
.Font.ColorIndex = 5 'Blue
End With
ElseIf IsDate(Cells(X, 12).Value) = True Then 'Col L
With Cells(X, 3)
.Value = "E"
.Font.ColorIndex = 1 'Black
End With
End If
End Select
End With

ExitEary:
Next X

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With

End Sub

[/vba]

Let us know if you need further tweaks

[JELL]

Philcjr, this is almost exactly what I want but is it possible to change it so that

1) The text colour of the whole row matches that of cell c ( green, red or blue ) and

2) If cell c = CW and the date in cell J has passed then CW will automatically, when the document is opened, be replaced with a "C" and the whole row text colour will change to red

Thanks, Jell

[Philcjr]

Jell,
Sorry I have been busy with the family... here is what I have for ya...

In your Workbook_Open routine, copy this
[vba]
'Name your worksheet accordingly for "Sheet1" with whatever you named it
Worksheets("Sheet1").Select
Call Module1.ChangeColorBasedOnCellValue
[/vba]
In your worksheet_Change routine, copy this
[vba]
If Intersect(Range("O:O"), Target) Is Nothing Then Exit Sub
Call Module1.ChangeColorBasedOnCellValue
[/vba]
Copy this to any Module
[vba]
Sub ChangeColorBasedOnCellValue()

Dim X As Long, LastRow As Long

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

'Clear Column C and set all cells to have a Blank Font
With Columns("C")
.Clear
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 1 'Black
End With

'Define what the last row is by looking in Col O
Let LastRow = Range("O" & Rows.Count).End(xlUp).Row

'Loop through from Row 1 to the LastRow
For X = 1 To LastRow
' Test Cell in Col O to see if empty
If IsEmpty(Cells(X, 15)) Then GoTo ExitEary

With Cells(X, 15)
' Convert value to Upper Case
Select Case UCase(.Value)
Case "C"
With Cells(X, 10) 'Col J
If IsDate(.Value) And .Value > Now() Then
Cells(X, 3).Value = "CW"
With Rows(X).Font
.Bold = True
.ColorIndex = 10 'Dark Green
End With
ElseIf IsDate(.Value) And .Value <= Now() Then
Cells(X, 3).Value = "C"
With Rows(X).Font
.Bold = True
.ColorIndex = 3 'Red
End With
End If
End With
Case "N"
With Cells(X, 16) 'Col P
If IsEmpty(Cells(X, 16)) Then
Cells(X, 3).Value = "W"
With Rows(X).Font
.Bold = True
.ColorIndex = 5 'Blue
End With
ElseIf IsDate(.Value) Then
Cells(X, 3).Value = "E"
With Rows(X).Font
.Bold = True
.ColorIndex = 1 'Black
End With
End If
End With
Case "RC"
If IsEmpty(Cells(X, 12).Value) = True Then 'Col L
Cells(X, 3).Value = "W"
With Rows(X).Font
.Bold = True
.ColorIndex = 5 'Blue
End With
ElseIf IsDate(Cells(X, 12).Value) = True Then 'Col L
Cells(X, 3).Value = "C"
With Rows(X).Font
.Bold = True
.ColorIndex = 3 'Red
End With
End If
Case "RN"
If IsEmpty(Cells(X, 12).Value) = True Then 'Col L
Cells(X, 3).Value = "W"
With Rows(X).Font
.Bold = True
.ColorIndex = 5 'Blue
End With
ElseIf IsDate(Cells(X, 12).Value) = True Then 'Col L
Cells(X, 3).Value = "E"
With Rows(X).Font
.Bold = True
.ColorIndex = 1 'Black
End With
End If
End Select
End With

ExitEary:
Next X
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With

MsgBox "Your Values have been updated and Font Colors have been set", vbInformation

End Sub
[/vba]

[Philcjr]

sidenotes:
where you see Module1 = this is the name the module

where you see ChangeColorBasedOnCellValue = this is the name of the sub routine within Module1... you can name this anything you want, but be sure that these names align or else the coding will not work

[JELL]

Philcjr, many thanks now works perfectly. I've been away so haven't had a chance to reply before now.

jell

[Philcjr]

Anytime, glad I was able to help...

be sure to mark this thread as "Solved" ... "Threat Tools --> "Solved"