VBA - conditional formatting on several sheets

[pt966]

Hi - I am a "newbie" playing with a small VBA routine that I am trying to apply to an existing workbook for sorting out the annual leave allocation within our office.

The workbook is set up so that each staff member has their own calendar sheet.
Each sheet is then linked to twelve monthly sheets - change an entry on the individuals sheet and it changes to relevant months sheet.

What I have been doing "manually" up to now is then checking the monthly sheets and highlighting each changed cell according to its contents.

The sheets are also used for recording sickness and courses etc.

I have recently found out about Excel's "conditional formatting" but it doesn't give enough colour options.

I have seen a "post" (on this site) with a VBA routine for this style of formatting and also seen a "post" on another site with a similar, shorter, solution.

I have amended the "second" "posted" routine to reflect my usage and it works on one sheet of a new workbook when I enter the value directly on that sheet.
If I link the first sheet (formatted) to a second sheet (i.e. make the formatted cell "=sheet2!A1" for example) then the routine doesn't recognise that the character content of the formatted cell has changed (when a different character is entered into the linked cell on sheet 2).


Also, if I then enter the same VBA code onto another sheet in the same book - it doesn't work even if the characters are entered directly onto that sheet.

Please can you help me by explaining, in simple terms(?), how to get it to work, on all of the monthly sheets (called "Jan", "Feb", ..... "Dec"), so that a change to the individuals sheet (sheet1! for example) would be recognised on the monthly sheet ("Jan" for example) and its colour changed?

I have listed the VBA routine below:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer
If Not Intersect(Target, Range("D5:AH32")) Is Nothing Then
Select Case Target
Case "R"
icolor = 6
Case "A"
icolor = 12
Case "B"
icolor = 53
Case "C"
icolor = 15
Case "S"
icolor = 42
Case Else
'Whatever
End Select

Target.Interior.ColorIndex = icolor

End If


End Sub


For reference, R=Rota day off, A & B are different types of annual leave, C=Course leave and S=sick
The range (D5:AH32) is the area of the excel worksheet that I need to format.
"icolor" value sets the new colour for the cell that has changed.


Many thanks (in anticipation) for any assistance that you might be able to give me.

Peter

[rory]

The change event is not triggered by formula calculation so you would have to use the Calculate event instead, but this does not provide a range argument so you would have to check every cell in the range you want. To run it for all sheets int he workbook, you can use the Workbook's SheetCalculate event:
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim icolor As Long, rngCell As Range
For Each rngCell In Sh.Range("D5:AH32")
Select Case rngCell.Value
Case "R"
icolor = 6
Case "A"
icolor = 12
Case "B"
icolor = 53
Case "C"
icolor = 15
Case "S"
icolor = 42
Case Else
'Whatever
End Select

rngCell.Interior.ColorIndex = icolor
Next rngCell
End Sub

This goes into the ThisWorkbook module and replaces any worksheet module change events you are using now to colour the cells.

Bear in mind though that this will run every time a calculation occurs in your workbook, which you may find annoying and it will slow the workbook down somewhat!

[pt966]

:cloud9: WOW!
Thanks Rory. :joy:

As and when I get chance I will try this solution.


Many thanks again!

Peter

:ole:

[pt966]

Rory - slight problem....

When a change is made to made to an individual person's sheet, it is acknowledged on the corresponding calendar sheet - but not as intended.

Example -I entered an "R" into January 1st (which would be D6 on the calendar sheet). This resulted in all cells on the January sheet (D5:AH31) turning yellow.
Changing the "R" to a "C" resulted in cells D6:AH6 being coloured Grey (the rest remaining yellow)
Any other changes results in the corresponding line of cells being changed, but the sheet staying as yellow.

Any ideas??

Peter

:boohoo

[Bob Phillips]

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim icolor As Long, rngCell As Range
For Each rngCell In Sh.Range("D5:AH32")
icolor = xlColorIndexNone
Select Case rngCell.Value
Case "R"
icolor = 6
Case "A"
icolor = 12
Case "B"
icolor = 53
Case "C"
icolor = 15
Case "S"
icolor = 42
Case Else
'Whatever
End Select

rngCell.Interior.ColorIndex = icolor
Next rngCell
End Sub

[rory]

Just as an alternative, you could actually use the Case Else bit:
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim icolor As Long, rngCell As Range
For Each rngCell In Sh.Range("D5:AH32")
Select Case rngCell.Value
Case "R"
icolor = 6
Case "A"
icolor = 12
Case "B"
icolor = 53
Case "C"
icolor = 15
Case "S"
icolor = 42
Case Else
icolor = xlColorIndexNone
End Select

rngCell.Interior.ColorIndex = icolor
Next rngCell
End Sub

[pt966]

Rory / XLD
Thanks for your assistance - I will try both suggestions and let you know the results!
Probably won't be until later today or over the weekend.

Peter
:bow: