PDA

View Full Version : [SOLVED] Conditional Formatting with VB



tsousa
02-17-2005, 04:41 PM
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
02-17-2005, 06:30 PM
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
02-18-2005, 04:59 AM
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
02-18-2005, 05:19 AM
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 :hi:

tsousa
02-18-2005, 05:46 AM
it is solved, thank you
Teresa

johnske
02-18-2005, 05:56 AM
You're welcome, not a prob... :)