"Case" structure code revision

[sampson32]

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
_________________

 

[sampson32]

Kristy -

There is no problem with your code but I ran into a small issue that I would appreciate your help with.

The app that your code will be used in is an existing unsigned “shared” workbook that has many entries.

This creates two issues –

Issue 1; upon implementation of your code it will not be retroactive on existing data.

Issue 2; upon opening the workbook if a user disables macros (which has happened) the code will not function on user entries which reverts me back to Issue 1

I put my original code (below) in the workbook open event so that it runs concurrent with yours and covers most of the above issues except I don’t know how to use this line of code in this particular procedure.
I spent all day yesterday to no avail searching for something on this type of action.

*********
'If .Value - Cells(Target.Row, "G").Value >= 2 Then
*********
I’m sure I’m doing something wrong

Thank you,

Vinnie

***********************************************
Private Sub Workbook_Open()
Dim i As Long, myLastRow As Long
Dim Today
Today = Date
myLastRow = Range("D65536").End(xlUp).Row

For i = 3 To myLastRow
If Range("F" & i).Value <> "" Then
If Range("G" & i).Value = "" Then
If Range("F" & i).Value < Today Then
Range("F" & i).Interior.ColorIndex = 3
End If
End If
End If

Next i

For i = 3 To myLastRow
If Range("G" & i).Value <> "" Then
Range("F" & i).Interior.ColorIndex = xlNone
End If

Next i

For i = 3 To myLastRow
If Range("H" & i).Value = "" Then
Range("H" & i).Interior.ColorIndex = xlNone
End If

Next i

*********************************
This is what I was trying
*********************************

For i = 3 To myLastRow

If Range("H" & i).Value - Range("G" & i).Value >= 2 Then

Range("H" & i).Interior.ColorIndex = 3

End If

Next i
********************************

End Sub

 

[Von Pookie]

Issue 1; upon implementation of your code it will not be retroactive on existing data.

As it is currently written, correct. That's because it's a Change event macro, so unless something changes on a sheet, nothing's going to happen.

I put my original code (below) in the workbook open event so that it runs concurrent with yours and covers most of the above issues except I don’t know how to use this line of code in this particular procedure.
I spent all day yesterday to no avail searching for something on this type of action.

'If .Value - Cells(Target.Row, "G").Value >= 2 Then

The problem with this is that the Workbook_Open event does not use the Target variable as the original code is using.

In the Change event code, the word Target refers to the changed cell(s). The Open event doesn't use it, so there is no Target to refer to.

Try:

If cells(i,"H").value-Cells(i,"G").value >=2 Then

Where i is the row number.

This isn't really tested, but maybe this would work?

Private Sub Workbook_Open()
Dim i As Long, myLastRow As Long

myLastRow = Range("D65536").End(xlUp).Row

For i = 3 To myLastRow
   If Cells(i, "F").Value <> "" And _
   Cells(i, "F").Value < Date And Cells(i, "G") = "" Then
      Cells(i, "F").Interior.ColorIndex = 3
   End If
   
   If Cells(i, "G").Value <> "" Then
      Cells(i, "F").Interior.ColorIndex = xlNone
   End If

   If Cells(i, "H").Value = "" Then
      Cells(i, "H").Interior.ColorIndex = xlNone
   ElseIf Cells(i, "H").Value - Cells(i, "G").Value >= 2 Then
      Cells(i, "H").Interior.ColorIndex = 3
   End If
Next i

End Sub

 

[sampson32]

Thanks Kristy!

Your code is written much better – This is teaching me a lot.

I found out over the weekend that it’s possible for this sheet to have entries other than dates (the particular instance I found was the word “Cancelled” parsed out into 9 cells).

Thus it was necessary to incorporate an “If IsDate” function into the code.
and I used a different variation of the line of code in question

Hope the alteration is up par!

Thanks Vinnie

************************
Private Sub Workbook_Open()
Dim i As Long, myLastRow As Long

myLastRow = Range("D65536").End(xlUp).Row

For i = 3 To myLastRow
If Cells(i, "F").Value <> "" And _
Cells(i, "F").Value < Date And Cells(i, "G") = "" Then
Cells(i, "F").Interior.ColorIndex = 3
End If

If Cells(i, "G").Value <> "" Then
Cells(i, "F").Interior.ColorIndex = xlNone
End If

If Cells(i, "H").Value = "" Then
Cells(i, "H").Interior.ColorIndex = xlNone
End If

If IsDate(Cells(i, "G").Value) And _
IsDate(Cells(i, "H").Value) Then
If Cells(i, "H").Value >= Cells(i, "G").Value + 2 Then
Cells(i, "H").Interior.ColorIndex = 3
End If
End If
Next i

End Sub

 

[Von Pookie]

Ah. Yeah, that's something I really should have put in in the first place--not sure why I didn't, though