Adding more than 3 conditional formatting options using VBA

[beans_21]

Hi All,

I'm creating a staff leave planner. At the moment the three conditional formatting options that Excel 2003 offer are being used up. I need to add two more conditions. After researching it, I believe the only way to do is by writing VBA.

The first condtion I need to add on is on a range of cells C12:AG41. The condtion I need to add is:
if cell = not null
then if cell A12="A" then colour red
else if cell A12="S" then colour blue

and then for each the row number needs to change for each row, so A12, A13, A14 etc - could the formula be looped for maybe?

If I were going to do it using the proper excel way, then the formula I would use, is:

=IF(A12="a",(IF(C12="",FALSE,TRUE)),FALSE) and the second condtion =IF(A12="s",(IF(C12="",FALSE,TRUE)),FALSE)

I hope this makes some sort of sense and it is possible to be done. Any help would be very much appeciated.

Thanks,

Dave

[Simon Lloyd]

Try this:

Private Sub Worksheet_Calculate() 
'Code must be placed in the  worksheet codemodule of the worksheet you are working on 
Dim Cel As Range 
For Each Cel In Range("C12:AG41") 
Select Case Cel.Value 
Case Is ="" 
Cel.Interior.ColorIndex = xlNone 
Case Is = "A" 
Cel.Interior.ColorIndex = 3 
Case Is = "S" 
Cel.Interior.ColorIndex = 5 
Case Is = "?" 
Cel.Interior.ColorIndex = 6 

End Select 
Next Cel 
End Sub

Regards,
Simon

[beans_21]

Hi Simon,

Thanks for your response, and that code does work, but I was needing it to be slightly different. For example I type a number into Cell F12, I need it to then look at cell A12 and then see if that has A or S in then colour it appropriately. And then the same for F13 would need to look at A13 etc etc.

Thanks for your help so far!

Dave

[Leith Ross]

Hello Beans,

Add this macro to the Worksheet_Change event procedure for each worksheet you want the macro to run on. When the user changes a cell in the range of C12 to AG41, if the that cell is not empty the corresponding cell in column "A" of that row will be checked for either an "A" or "S" and colored either red or blue.

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim Cell As Range
  Dim ColorCell As Range
  Dim N As Long
  Dim R As Long

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

    For Each Cell In ActiveSheet.Range("C12:AG41")
      R = Cell.Row
      Set ColorCell = ActiveSheet.Cells(R, "A")
        If Cell.Value <> "" Then
          Select Case LCase(ColorCell.Value)
            Case Is = "a"
              N = 3     'Red
            Case Is = "s"
              N = 5     'Blue
            Case Else
              N = xlColorIndexNone
          End Select
          ColorCell.Interior.ColorIndex = N
        End If
    Next Cell

End Sub

Sincerely,
Leith Ross

[Simon Lloyd]

I guess you should have posted the whole story then folk wouldn't waste time coming up with a solution that you didn't want in the first place!

However, this goes in the worksheet module and will work with which ever range you set the target to!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Variant
Dim Nb As Integer
Dim Nc As integer
Nb = ActiveCell.Row 
Nc = ActiveCell.Column
Set R = Cells(Nb, Nc)
If Not Intersect(Target, Range("B1:AG41")) Is Nothing Then
If Cells(Nb, 1) = "" Then
R.Interior.ColorIndex = xlNone
ElseIf Cells(Nb, 1) = "A" Then
R.Interior.ColorIndex = 3
ElseIf Cells(Nb, 1) = "S" Then
R.Interior.ColorIndex = 5

End If
End If
End Sub

Regards,
Simon

[beans_21]

Hi,

Appologies for the mis-guidence, I didn't mean to waste your time. Thank you for looking at the code again for me. It now works fine.

Thanks again!

Regards,

Dave