View Full Version : Excel VBA Change text colour depending on another cell's content
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
02-12-2010, 09:24 PM
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.
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
Let us know if you need further tweaks
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
02-16-2010, 12:32 PM
Jell,
Sorry I have been busy with the family... here is what I have for ya...
In your Workbook_Open routine, copy this
'Name your worksheet accordingly for "Sheet1" with whatever you named it
Worksheets("Sheet1").Select
Call Module1.ChangeColorBasedOnCellValue
In your worksheet_Change routine, copy this
If Intersect(Range("O:O"), Target) Is Nothing Then Exit Sub
Call Module1.ChangeColorBasedOnCellValue
Copy this to any Module
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
Philcjr
02-16-2010, 12:35 PM
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
Philcjr, many thanks now works perfectly. I've been away so haven't had a chance to reply before now.
jell
Philcjr
02-25-2010, 02:38 PM
Anytime, glad I was able to help...
be sure to mark this thread as "Solved" ... "Threat Tools --> "Solved"
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.