conditional formatting based on date?

[anon125]

how do i word the if statement that depending on date the fill color should be say yellow?
I have a calender with each date showing. i need the fill color to depend on which date range it's date is in.

thanks

[anon125]

here is my umteenth try!

[mdmackillop]

You are using Change Events to alter cell colours. Can you explain exactly what you are trying to achieve?

[anon125]

You are using Change Events to alter cell colours. Can you explain exactly what you are trying to achieve?
The final result would be this:
i key in the number of days at each stop.
this creates 8 date ranges (at the top)
the calender days fill color would reflect how many days i was at each stop.
so going down would be say 7 days so from dec 1 for 7 days would be say yellow fill.
when i stayed say 31 days at the first stop the next 31 days would be another color - in the calender at the bottom.
and so on
Thanks

[mdmackillop]

Give this try
It will recolour cells when a number is changed in the bordered area A1:A15
Slight hitch; It adds an extra coloured cell at the end!
Regards
MD

[Bob Phillips]

Sub Calender()
Dim CellColour As Long
Dim Numdays As Long
Dim StartDate As Date
Dim ThisMonth As Date
Dim i As Long, j As Long, k As Long

For i = 1 To 15 Step 2

Numdays = Cells(i, "A").Value
StartDate = Cells(i, "B").Value
CellColour = Cells(i + 1, "A").Interior.ColorIndex

For j = 19 To 55

If Cells(j, "A").MergeCells Then

ThisMonth = Cells(j, "A").Value
j = j + 1
Else

For k = 1 To 7

If Cells(j, k).Value <> "" Then

If Cells(j, k).Value >= StartDate And _
Cells(j, k).Value <= StartDate + Numdays Then

Cells(j, k).Interior.ColorIndex = CellColour
End If
End If
Next k
End If
Next j
Next i

End Sub

[mdmackillop]

Hi Bob
I see your does an extra day as well!
Regards
Malcolm

[Bob Phillips]

Sub Calender()
Dim CellColour As Long
Dim Numdays As Long
Dim StartDate As Date
Dim ThisMonth As Date
Dim i As Long, j As Long, k As Long

For i = 1 To 15 Step 2

Numdays = Cells(i, "A").Value
StartDate = Cells(i, "B").Value
CellColour = Cells(i + 1, "A").Interior.ColorIndex

For j = 19 To 55

If Cells(j, "A").MergeCells Then

ThisMonth = Cells(j, "A").Value
j = j + 1
Else

For k = 1 To 7

If Cells(j, k).Value <> "" Then

If Cells(j, k).Value >= StartDate And _
Cells(j, k).Value <= StartDate + Numdays - 1 Then

Cells(j, k).Interior.ColorIndex = CellColour
End If
End If
Next k
End If
Next j
Next i

End Sub

[anon125]

I don't see anything happening!
i mean when i change a date no fill or font colors change.
i am probably missing something!
i renamed the file with the above VBA code
thanks

[mdmackillop]

Add this to the worksheet module to use XLD's code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim monrange As Range
Set monrange = Range("A1,A3,A5,A7,A9,A11,A13,A15")
If Intersect(Target, monrange) Is Nothing Then Exit Sub
Calender
End Sub

[anon125]

Thanks (fellow scot!)
could i use the original without the added bit as a macro?
that would be great!
thanks very much

[Bob Phillips]

You could just execute the original, it doesn't have to be driven by a change event.

[anon125]

One LAST thing
i wish to have 5 of these macros on the same page with 5 calenders.
each operating singly. i will only use one at a time.
do i just change the letters in the macro- A B etc for the rest?

OOPS forgot the important thing.
Thanks Very Much.

[mdmackillop]

You can pass variables to another routine to carry out similar tasks on a different range. In this case, pass the Column Number.


Sub Cal1()
Call Calender(1)
End Sub

Sub Cal2()
Call Calender(9)
End Sub

Sub Calender(Col As Long)
Dim CellColour As Long
Dim Numdays As Long
Dim StartDate As Date
Dim ThisMonth As Date
Dim i As Long, j As Long, k As Long

For i = 1 To 15 Step 2
Numdays = Cells(i, Col).Value
StartDate = Cells(i, Col + 1).Value
CellColour = Cells(i + 1, Col).Interior.ColorIndex

For j = 19 To 55
If Cells(j, Col).MergeCells Then
ThisMonth = Cells(j, Col).Value
j = j + 1
Else
For k = Col To Col + 6
If Cells(j, k).Value <> "" Then
If Cells(j, k).Value >= StartDate And _
Cells(j, k).Value <= StartDate + Numdays - 1 Then
Cells(j, k).Interior.ColorIndex = CellColour
End If
End If
Next k
End If
Next j
Next i
End Sub

[anon125]

sorry
I have no idea how to "pass variables to another routine to carry out similar tasks on a different range. In this case, pass the Column Number."

so please give me a clue! (or 2)
thanks

[mdmackillop]

You have two!

Sub Cal1()
Call Calender(1)
End Sub

Sub Cal2()
Call Calender(9)
End Sub


Assign a button to each macro Cal1 & Cal2. Add more as you need them.

[Bob Phillips]

If they are evenly spaced you can use a loop



Sub Cal1()
Dim i As Long
For i = 1 to 33 Step 8 ' adjust as appropriate

Call Calender(i)
Next i
End Sub

[anon125]

If they are evenly spaced you can use a loop



Sub Cal1()
Dim i As Long
For i = 1 to 33 Step 8 ' adjust as appropriate

Call Calender(i)
Next i
End Sub


Thanks but...
Compile error
"wrong number of arguments or invalid property assignment."
i have 5 calenders so i changed it to 5. to 5 step 9
maybe i only need 4
UPDATE: 4 gives the same error
we are so close to getting this to work.
thanks

[mdmackillop]

Can you post your workbook showing all the calenders?

[anon125]

Can you post your workbook showing all the calenders?

as requested
5 of them cos they fit on one page
The buttons are not activated yet.
thanks VERY much for your help

[Bob Phillips]

Exactly as we said



Sub Cal1()
Dim i As Long
For i = 1 To 33 Step 8 ' adjust as appropriate

Call Calender(i)
Next i
End Sub
Sub Calender(Col As Long)
Dim CellColour As Long
Dim Numdays As Long
Dim StartDate As Date
Dim ThisMonth As Date
Dim i As Long, j As Long, k As Long

For i = 1 To 15 Step 2

Numdays = Cells(i, Col).Value
StartDate = Cells(i, Col + 1).Value
CellColour = Cells(i + 1, Col).Interior.ColorIndex

For j = 19 To 55
If Cells(j, Col).MergeCells Then
ThisMonth = Cells(j, Col).Value
j = j + 1
Else
For k = Col To Col + 6
If Cells(j, k).Value <> "" Then
If Cells(j, k).Value >= StartDate And _
Cells(j, k).Value <= StartDate + Numdays - 1 Then
Cells(j, k).Interior.ColorIndex = CellColour
End If
End If
Next k
End If
Next j
Next i
End Sub

[mdmackillop]

Try this

[anon125]

Try this
thanks
So Close!
it puts an extra day - white
between the first dates and the second dates.
I tried 1,2,3,4,5 as the first trip length
and there was always an extra day after it.
that clear all is a brain wave!
thanks

[mdmackillop]

Insert the last line as shown here

For i = 1 To 15 Step 2
Numdays = Cells(i, Col).Value
If i = 1 Then Numdays = Numdays + 1

[anon125]

Insert the last line as shown here

For i = 1 To 15 Step 2
Numdays = Cells(i, Col).Value
If i = 1 Then Numdays = Numdays + 1


I just get a compile error
please put it in the macros - i assume in all the 5 of them and repost the file
thanks

[mdmackillop]

Here it is

[anon125]

The extra day problem was NOT with the macro
it was with MY spreadsheet.
onthe date for the first date.
THAT is where the extra day was coming in.
SORRY about that and thanks VERY much

[anon125]

prettied up a bit version