Conditional Formatting with VB

[tsousa]

The information is displayed on a calendar made in excel (with the design of a regular calendar), were you have one column for the weekday of the month another one for the values of hotel occupancy for that day, and this repeats for the other columns.
On the cell I want to colour I have already a logical formula that gives me a text code (like TB1, Tb2 and so on...)
I want to attach to each text code (in my example are price tables) a color, I have 5 price tables.

I have tried to use the code below plus the module with no success. (I am only testing the first month)

Private Sub Worksheet_Change(ByVal Target As Range) 
With Target 
If .Cells.Count > 1 Then Exit Sub 'quit if more than 1 cell is selected 
If Not Intersect(Target, [b4:o9]) Is Nothing Then 
Select Case .Value 
Case "TB1" 
.Interior.ColorIndex = 40 
Case "TB2" 
.Interior.ColorIndex = 3 
Case "TB3" 
.Interior.ColorIndex = 4 
Case "TB4" 
.Interior.ColorIndex = 5 
Case "TB5" 
.Interior.ColorIndex = 6 
Case Else 
.Interior.ColorIndex = 0 
End Select 
End If 
End With 
End Sub

Module

Option Explicit 
 
Sub RunOncePlease() 
Dim cel As Range, rng As Range 
Set rng = Range("A2:H366") 'will assume this is the activesheet 
Select Case cel.Value 
With cel.Interior 
Case "TB1": .ColorIndex = 40 
Case "TB2": .ColorIndex = 3 
Case "TB3": .ColorIndex = 4 
Case "TB4": .ColorIndex = 5 
Case "TB5": .ColorIndex = 6 
Case Else: .ColorIndex = 0 
End With 
End Select 
End Sub

Error when i run the macro: with cel.interior statement or lable is not valid by reference to first case

I really do not know how to work it out, if someone could help.
Thank You
Teresa

[johnske]

Hi Teresa,

Try this for the module (it does the same thing as the Case statement you're using):

Sub RunOncePlease()
Dim Cell As Range
For Each Cell In Range("A2:H366")
If Cell = "TB1" Then
Cell.Interior.ColorIndex = 40
ElseIf Cell = "TB2" Then
Cell.Interior.ColorIndex = 3
ElseIf Cell = "TB3" Then
Cell.Interior.ColorIndex = 4
ElseIf Cell = "TB4" Then
Cell.Interior.ColorIndex = 5
ElseIf Cell = "TB5" Then
Cell.Interior.ColorIndex = 6
Else: Cell.Interior.ColorIndex = 0
End If
Next Cell
End Sub

PS: If you prefer to do it as a selection change event, (from your code above) try this:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [b4:o9]) Is Nothing Then
Exit Sub
Else
For Each Cell In Range("b4:o9")
If Cell = "TB1" Then
Cell.Interior.ColorIndex = 40
ElseIf Cell = "TB2" Then
Cell.Interior.ColorIndex = 3
ElseIf Cell = "TB3" Then
Cell.Interior.ColorIndex = 4
ElseIf Cell = "TB4" Then
Cell.Interior.ColorIndex = 5
ElseIf Cell = "TB5" Then
Cell.Interior.ColorIndex = 6
Else: Cell.Interior.ColorIndex = 0
End If
Next Cell
End If
End Sub

HTH
John

[tsousa]

Just to tell you that it is working fine. Thank you.
Just one more question is there any way to make the module run on the click of save in excel?

Thks
Teresa

[johnske]

Just to tell you that it is working fine. Thank you.
Just one more question is there any way to make the module run on the click of save in excel?

Thks
Teresa

Hi Teresa,

Yes, put this (it's your "RunOncePlease" macro) in the "ThisWorkbook" module:

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Sheets(1).Activate
Dim Cell As Range
For Each Cell In Range("A2:H366")
If Cell = "TB1" Then
Cell.Interior.ColorIndex = 40
ElseIf Cell = "TB2" Then
Cell.Interior.ColorIndex = 3
ElseIf Cell = "TB3" Then
Cell.Interior.ColorIndex = 4
ElseIf Cell = "TB4" Then
Cell.Interior.ColorIndex = 5
ElseIf Cell = "TB5" Then
Cell.Interior.ColorIndex = 6
Else: Cell.Interior.ColorIndex = 0
End If
Next Cell
End Sub

If this does what you want, you can mark your thread "solved" by going to Thread Tools (above) mark "Solved" and then Perform action..

And welcome to VBAX...

Regards,
John


EDIT: Ps: I've assumed here that your calendar is in sheet1 - if it's not, just change it to the correct one

[tsousa]

it is solved, thank you
Teresa

[johnske]

You're welcome, not a prob...