Change based on date

[lonnierudd via OfficeKB.com]

Hello,
I would like to be able to change the formatting of a limited row of cells
based on the date. By that I mean if an entered date is July 31, 2008, then
one row of cells is formatted with a box around it, If August 31, 2008
another row is boxed in, etc. This would need to carry through all the sheets
in the workbook (80+). There is a data entry box where the date is entered
that is used for other coding, so I could point the code to that. The first
cell in the row that is to be boxed has a date in it, and is part of a
vlookup table, so I assume the code I'm looking for can use that table also?
Below is the code I'm using, but right now it's a manual process to change
the row I want boxed. I'd like to automate it without having to make 80 odd
macros. Columns C through AB need to have the box around them. Also, can I
clean up the formatting code at all? I would appreciate any help.

Sub Macro2()
'
' Macro2 Macro
' Macro recorded 7/28/2008 by Lonnie Franklin Rudd
'
Dim sh As Worksheet
For i = 1 To Sheets.Count
Set sh = Sheets(i)
sh.Activate

Range("C16:AB16").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Range("A1").Select


Next i
'
End Sub

 

[Bob Phillips]

Sub Macro2()
Dim i As Long
Dim rng As Range
Dim sh As Worksheet

For i = 1 To Sheets.Count

Set sh = Sheets(i)

Select Case Date

Case #7/27/2008#: Set rng = sh.Range("C16:AB16")
Case #8/31/2008#: Set rng = sh.Range("C17:AB17")
Case Else: Set rng = Nothing

End Select

If Not rng Is Nothing Then

With rng

.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With
End If
Next i
'
End Sub

 

[lonnierudd via OfficeKB.com]

It didn't work, probably because it isn't referring to where the date is?
Just guessing. The end of month date that is entered will be in cell B1
(sorry I didn't say that before). I can't have it based on NOW() since it
might be run at any time the following month. I haven't used the Case
function before, but it would certainly open up loads of learning for me. I
appreciate your help and time looking at this.

Sub Macro2()
Dim i As Long
Dim rng As Range
Dim sh As Worksheet

For i = 1 To Sheets.Count

Set sh = Sheets(i)

Select Case Date

Case #7/27/2008#: Set rng = sh.Range("C16:AB16")
Case #8/31/2008#: Set rng = sh.Range("C17:AB17")
Case Else: Set rng = Nothing

End Select

If Not rng Is Nothing Then

With rng

.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With
End If
Next i
'
End Sub

Hello,
I would like to be able to change the formatting of a limited row of cells

[quoted text clipped - 53 lines]

'
End Sub

 

[Bob Phillips]

Okay, so it should just be

Sub Macro2()
Dim i As Long
Dim rng As Range
Dim sh As Worksheet

For i = 1 To Sheets.Count

Set sh = Sheets(i)

Select Case sh.Range("B1").Value

Case #7/31/2008#: Set rng = sh.Range("C16:AB16")
Case #8/31/2008#: Set rng = sh.Range("C17:AB17")
Case Else: Set rng = Nothing

End Select

If Not rng Is Nothing Then

With rng

.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With
End If
Next i
'
End Sub

Just add more Case statements for more dates/rows.

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

It didn't work, probably because it isn't referring to where the date is?
Just guessing. The end of month date that is entered will be in cell B1
(sorry I didn't say that before). I can't have it based on NOW() since it
might be run at any time the following month. I haven't used the Case
function before, but it would certainly open up loads of learning for me.
I
appreciate your help and time looking at this.

Sub Macro2()
Dim i As Long
Dim rng As Range
Dim sh As Worksheet

For i = 1 To Sheets.Count

Set sh = Sheets(i)

Select Case Date

Case #7/27/2008#: Set rng = sh.Range("C16:AB16")
Case #8/31/2008#: Set rng = sh.Range("C17:AB17")
Case Else: Set rng = Nothing

End Select

If Not rng Is Nothing Then

With rng

.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With
End If
Next i
'
End Sub

Hello,
I would like to be able to change the formatting of a limited row of
cells

[quoted text clipped - 53 lines]

'
End Sub

 

[lonnierudd via OfficeKB.com]

That works, thanks! I forgot to put that I need to erase that box from the
previous month, but I think I can figure that out. I REALLY appreciate your
help!

Okay, so it should just be

Sub Macro2()
Dim i As Long
Dim rng As Range
Dim sh As Worksheet

For i = 1 To Sheets.Count

Set sh = Sheets(i)

Select Case sh.Range("B1").Value

Case #7/31/2008#: Set rng = sh.Range("C16:AB16")
Case #8/31/2008#: Set rng = sh.Range("C17:AB17")
Case Else: Set rng = Nothing

End Select

If Not rng Is Nothing Then

With rng

.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With
End If
Next i
'
End Sub

Just add more Case statements for more dates/rows.

It didn't work, probably because it isn't referring to where the date is?
Just guessing. The end of month date that is entered will be in cell B1

[quoted text clipped - 59 lines]