Below is the original code that was given to me by “Von Pookie” - beautifully written including comments so I can decipher it as needed and it works flawlessly!
I need to make some changes to it.
I can alter most of it as needed but in this “Case” structure I don’t know how to reference another cell instead of the computer "date" – I run into a problem at this point.
Instead of the “H” cell shaded red when the date in “F” is one or more days older than ‘Date”
I need it shaded red when the value in “H” is 2 or more days older than the value (date) in “F”.
Any help appreciated.
Thanks
Vinnie
‘*********************************************
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'if more than 1 cell changed, do not run macro
If Target.Count > 1 Then Exit Sub
'if changed cell was not in column F, G or H, do not run macro
If Intersect(Target, Columns("F:H")) Is Nothing Then Exit Sub
'runs code according to column the changed cell is in
With Target
Select Case .Column
Case Is = 6 'column F
Select Case .Value
'if value of changed cell is blank or _
greaterthan/equal to current date
Case Is = "", Is >= Date
'do not color column F cell
.Interior.ColorIndex = xlNone
'if value of changed cell is older than 1 day and _
cell in column G of same row is blank
Case Is < Date And Cells(Target.Row, "G") = ""
'color column F cell red
.Interior.ColorIndex = 3
End Select
Case Is = 7 'column G
Select Case .Value
'if value of changed cell is blank
Case Is = ""
'check the value of column F cell for same row
With Cells(Target.Row, "F")
If .Value = "" Then 'if blank, do not color column F cell
.Interior.ColorIndex = xlNone
'otherwise if date in column F cell is older than 1 day
ElseIf .Value < Date Then
'color column F cell red
.Interior.ColorIndex = 3
End If
End With
'no color in column H cell
Cells(Target.Row, "H").Interior.ColorIndex = xlNone
Case Else 'if column G cell is not blank
'no color in column F cell
Cells(Target.Row, "F").Interior.ColorIndex = xlNone
'if cell is older than 1 day and column H cell is blank
If .Value < Date And Cells(Target.Row, "H") = "" Then
'color column H cell red
Cells(Target.Row, "H").Interior.ColorIndex = 3
Else
'otherwise no color in column H cell
Cells(Target.Row, "H").Interior.ColorIndex = xlNone
End If
End Select
Case Is = 8 'column H
'if column H cell is blank
If .Value = "" Then
'check value of column G cell
Select Case Cells(Target.Row, "G").Value
Case Is = "" 'if blank
'no color in column H cell
.Interior.ColorIndex = xlNone
Case Is < Date 'if older than 1 day
'color column H cell red
.Interior.ColorIndex = 3
End Select
Else 'otherwise
'no color in column H cell
.Interior.ColorIndex = xlNone
End If
End Select
End With
End Sub
_________________
I need to make some changes to it.
I can alter most of it as needed but in this “Case” structure I don’t know how to reference another cell instead of the computer "date" – I run into a problem at this point.
Instead of the “H” cell shaded red when the date in “F” is one or more days older than ‘Date”
I need it shaded red when the value in “H” is 2 or more days older than the value (date) in “F”.
Any help appreciated.
Thanks
Vinnie
‘*********************************************
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'if more than 1 cell changed, do not run macro
If Target.Count > 1 Then Exit Sub
'if changed cell was not in column F, G or H, do not run macro
If Intersect(Target, Columns("F:H")) Is Nothing Then Exit Sub
'runs code according to column the changed cell is in
With Target
Select Case .Column
Case Is = 6 'column F
Select Case .Value
'if value of changed cell is blank or _
greaterthan/equal to current date
Case Is = "", Is >= Date
'do not color column F cell
.Interior.ColorIndex = xlNone
'if value of changed cell is older than 1 day and _
cell in column G of same row is blank
Case Is < Date And Cells(Target.Row, "G") = ""
'color column F cell red
.Interior.ColorIndex = 3
End Select
Case Is = 7 'column G
Select Case .Value
'if value of changed cell is blank
Case Is = ""
'check the value of column F cell for same row
With Cells(Target.Row, "F")
If .Value = "" Then 'if blank, do not color column F cell
.Interior.ColorIndex = xlNone
'otherwise if date in column F cell is older than 1 day
ElseIf .Value < Date Then
'color column F cell red
.Interior.ColorIndex = 3
End If
End With
'no color in column H cell
Cells(Target.Row, "H").Interior.ColorIndex = xlNone
Case Else 'if column G cell is not blank
'no color in column F cell
Cells(Target.Row, "F").Interior.ColorIndex = xlNone
'if cell is older than 1 day and column H cell is blank
If .Value < Date And Cells(Target.Row, "H") = "" Then
'color column H cell red
Cells(Target.Row, "H").Interior.ColorIndex = 3
Else
'otherwise no color in column H cell
Cells(Target.Row, "H").Interior.ColorIndex = xlNone
End If
End Select
Case Is = 8 'column H
'if column H cell is blank
If .Value = "" Then
'check value of column G cell
Select Case Cells(Target.Row, "G").Value
Case Is = "" 'if blank
'no color in column H cell
.Interior.ColorIndex = xlNone
Case Is < Date 'if older than 1 day
'color column H cell red
.Interior.ColorIndex = 3
End Select
Else 'otherwise
'no color in column H cell
.Interior.ColorIndex = xlNone
End If
End Select
End With
End Sub
_________________