"Case" structure code revision

sampson32

Active Member
Joined
Jul 16, 2003
Messages
312
Office Version
  1. 2021
Platform
  1. Windows
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
_________________
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
RE:
“Would H still need to change color according to the value in column G as well as F?”

No Kristy

“H” only has to change color (red) if and when there is an entry (date) in column “H” and this entry is 2 or more days older than the value (date) in column “G” – also it (the color) doesn’t need to be removed from “H” – when conditions cause the cells in column “H” to be colored it is permanent.

Thank you for your help.

Vinnie
 
Upvote 0
Oh, Ok. You were talking about the date in column F, above. I wasn't sure if this was something new, or if maybe you simply put the wrong column letter.

I'll have a look, though :)
 
Upvote 0
Ok, here's one go at it:

<font face=Tahoma><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Workbook_SheetChange(<SPAN style="color:#00007F">ByVal</SPAN> Sh <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)

<SPAN style="color:#007F00">'if more than 1 cell changed or if changed cell was not in _
column F, G or H, do not run macro</SPAN>
<SPAN style="color:#00007F">If</SPAN> Target.Count > 1 <SPAN style="color:#00007F">Or</SPAN> Intersect(Target, Columns("F:H")) <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>

<SPAN style="color:#007F00">'runs code according to column the changed cell is in</SPAN>
<SPAN style="color:#00007F">With</SPAN> Target
    <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> .Column
        <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> = 6 <SPAN style="color:#007F00">'column F</SPAN>
            <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> .Value
                <SPAN style="color:#007F00">'if value of changed cell is blank or _
                greaterthan/equal to current date</SPAN>
                <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> = "", <SPAN style="color:#00007F">Is</SPAN> >= <SPAN style="color:#00007F">Date</SPAN>
                    <SPAN style="color:#007F00">'do not color column F cell</SPAN>
                    .Interior.ColorIndex = xlNone
                <SPAN style="color:#007F00">'if value of changed cell is older than 1 day and _
                cell in column G of same row is blank</SPAN>
                <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> < <SPAN style="color:#00007F">Date</SPAN> And Cells(Target.Row, "G") = ""
                    <SPAN style="color:#007F00">'color column F cell red</SPAN>
                    .Interior.ColorIndex = 3
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
        <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> = 7 <SPAN style="color:#007F00">'column G</SPAN>
            <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> .Value
                <SPAN style="color:#007F00">'if value of changed cell is blank</SPAN>
                <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> = ""
                    <SPAN style="color:#007F00">'check the value of column F cell for same row</SPAN>
                    <SPAN style="color:#00007F">With</SPAN> Cells(Target.Row, "F")
                        <SPAN style="color:#00007F">If</SPAN> .Value = "" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#007F00">'if blank, do not color column F cell</SPAN>
                            .Interior.ColorIndex = xlNone
                        <SPAN style="color:#007F00">'otherwise if date in column F cell is older than 1 day</SPAN>
                        <SPAN style="color:#00007F">ElseIf</SPAN> .Value < <SPAN style="color:#00007F">Date</SPAN> <SPAN style="color:#00007F">Then</SPAN>
                            <SPAN style="color:#007F00">'color column F cell red</SPAN>
                            .Interior.ColorIndex = 3
                        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
                    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
                <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Else</SPAN> <SPAN style="color:#007F00">'if column G cell is not blank</SPAN>
                    <SPAN style="color:#007F00">'no color in column F cell</SPAN>
                    Cells(Target.Row, "F").Interior.ColorIndex = xlNone
                    
                    <SPAN style="color:#007F00">'no color in column G cell</SPAN>
                    .Interior.ColorIndex = xlNone
                    
                    <SPAN style="color:#007F00">'if column H cell is not blank</SPAN>
                    <SPAN style="color:#00007F">If</SPAN> Cells(Target.Row, "H").Value <> "" <SPAN style="color:#00007F">Then</SPAN>
                        <SPAN style="color:#007F00">'if column H cell is more than 2 days older than date in G</SPAN>
                        <SPAN style="color:#00007F">If</SPAN> .Value - Cells(Target.Row, "H").Value >= 2 <SPAN style="color:#00007F">Then</SPAN>
                            <SPAN style="color:#007F00">'color column H cell red</SPAN>
                            Cells(Target.Row, "H").Interior.ColorIndex = 3
                        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
                    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
        <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> = 8 <SPAN style="color:#007F00">'column H</SPAN>
            <SPAN style="color:#007F00">'if column H cell is not blank</SPAN>
            <SPAN style="color:#00007F">If</SPAN> .Value <> "" <SPAN style="color:#00007F">Then</SPAN>
                <SPAN style="color:#007F00">'if column H cell is more than 2 days older than date in G</SPAN>
                <SPAN style="color:#00007F">If</SPAN> Cells(Target.Row, "G").Value - .Value >= 2 <SPAN style="color:#00007F">Then</SPAN>
                    <SPAN style="color:#007F00">'color column H cell red</SPAN>
                    .Interior.ColorIndex = 3
                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>
 
Upvote 0
Kristy,

You’re correct – in my first post I stated the wrong column.

I tried your code out this morning. The “H” column/cell doesn’t seem to function.

I put in a date that is 2 days older than “G” and it never turned red.

Thanks,

Vinnie
 
Upvote 0
I played with the code and found that “H” is working in reverse of what I needed.

If “G” has, for example 10/29/2005, then “H” turns red if 10/27/2005 or earlier is entered.

I would like it to turn red if the date in “H” is 10/31/2005 or latter

I tried reversing the “greater/Less than" symbols but that didn’t work – then “H” turns red if I enter any date.

Vinnie
 
Upvote 0
Oh! Sorry. I was apparently thinking that "older" meant that the date in H would be 2 or more days *before* the date in G. :rolleyes:

I think all that it needs is to switch the calculation around so it's subtracting G from H to get the number of days instead of H from G.

Take 2:

<font face=Tahoma><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Workbook_SheetChange(<SPAN style="color:#00007F">ByVal</SPAN> Sh <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)

<SPAN style="color:#007F00">'if more than 1 cell changed or if changed cell was not in _
column F, G or H, do not run macro</SPAN>
<SPAN style="color:#00007F">If</SPAN> Target.Count > 1 <SPAN style="color:#00007F">Or</SPAN> Intersect(Target, Columns("F:H")) <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN>

<SPAN style="color:#007F00">'runs code according to column the changed cell is in</SPAN>
<SPAN style="color:#00007F">With</SPAN> Target
    <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> .Column
        <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> = 6 <SPAN style="color:#007F00">'column F</SPAN>
            <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> .Value
                <SPAN style="color:#007F00">'if value of changed cell is blank or _
                greaterthan/equal to current date</SPAN>
                <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> = "", <SPAN style="color:#00007F">Is</SPAN> >= <SPAN style="color:#00007F">Date</SPAN>
                    <SPAN style="color:#007F00">'do not color column F cell</SPAN>
                    .Interior.ColorIndex = xlNone
                <SPAN style="color:#007F00">'if value of changed cell is older than 1 day and _
                cell in column G of same row is blank</SPAN>
                <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> < <SPAN style="color:#00007F">Date</SPAN> And Cells(Target.Row, "G") = ""
                    <SPAN style="color:#007F00">'color column F cell red</SPAN>
                    .Interior.ColorIndex = 3
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
        <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> = 7 <SPAN style="color:#007F00">'column G</SPAN>
            <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> .Value
                <SPAN style="color:#007F00">'if value of changed cell is blank</SPAN>
                <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> = ""
                    <SPAN style="color:#007F00">'check the value of column F cell for same row</SPAN>
                    <SPAN style="color:#00007F">With</SPAN> Cells(Target.Row, "F")
                        <SPAN style="color:#00007F">If</SPAN> .Value = "" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#007F00">'if blank, do not color column F cell</SPAN>
                            .Interior.ColorIndex = xlNone
                        <SPAN style="color:#007F00">'otherwise if date in column F cell is older than 1 day</SPAN>
                        <SPAN style="color:#00007F">ElseIf</SPAN> .Value < <SPAN style="color:#00007F">Date</SPAN> <SPAN style="color:#00007F">Then</SPAN>
                            <SPAN style="color:#007F00">'color column F cell red</SPAN>
                            .Interior.ColorIndex = 3
                        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
                    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
                <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Else</SPAN> <SPAN style="color:#007F00">'if column G cell is not blank</SPAN>
                    <SPAN style="color:#007F00">'no color in column F cell</SPAN>
                    Cells(Target.Row, "F").Interior.ColorIndex = xlNone
                    
                    <SPAN style="color:#007F00">'no color in column G cell</SPAN>
                    .Interior.ColorIndex = xlNone
                    
                    <SPAN style="color:#007F00">'if column H cell is not blank</SPAN>
                    <SPAN style="color:#00007F">If</SPAN> Cells(Target.Row, "H").Value <> "" <SPAN style="color:#00007F">Then</SPAN>
                        <SPAN style="color:#007F00">'if column H cell is more than 2 days older than date in G</SPAN>
                        <SPAN style="color:#00007F">If</SPAN> Cells(Target.Row, "H").Value - .Value >= 2 <SPAN style="color:#00007F">Then</SPAN>
                            <SPAN style="color:#007F00">'color column H cell red</SPAN>
                            Cells(Target.Row, "H").Interior.ColorIndex = 3
                        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
                    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
        <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Is</SPAN> = 8 <SPAN style="color:#007F00">'column H</SPAN>
            <SPAN style="color:#007F00">'if column H cell is not blank</SPAN>
            <SPAN style="color:#00007F">If</SPAN> .Value <> "" <SPAN style="color:#00007F">Then</SPAN>
                <SPAN style="color:#007F00">'if column H cell is more than 2 days older than date in G</SPAN>
                <SPAN style="color:#00007F">If</SPAN> .Value - Cells(Target.Row, "G").Value >= 2 <SPAN style="color:#00007F">Then</SPAN>
                    <SPAN style="color:#007F00">'color column H cell red</SPAN>
                    .Interior.ColorIndex = 3
                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>
 
Upvote 0
Kristy -

This works great! I am indebted to you.

Considering that it is possible to inadvertently enter an incorrect date which turns the cell red. Would this be the correct code to add to Case 8 to allow date/color correction?

If .Value “ “ Then
.Interior.ColorIndex = xlNone

P.S. The change you made between the 2 versions of your code explained to me the concept behind the hyphen in that line of code. Before I couldn’t grasp what it was for.

Thanks so much!

Vinnie
 
Upvote 0
sampson32 said:
Considering that it is possible to inadvertently enter an incorrect date which turns the cell red. Would this be the correct code to add to Case 8 to allow date/color correction?

Sure!

Try using this code for the Column H case:

Code:
Case Is = 8 'column H
            'if column H cell is blank
            If .Value = "" Then
                'no color in column H cell
                .Interior.ColorIndex=xlNone
            'if column H cell is more than 2 days older than date in G
            ElseIf .Value - Cells(Target.Row, "G").Value >= 2 Then
                'color column H cell red
                .Interior.ColorIndex = 3
             End If
    End Select

P.S. The change you made between the 2 versions of your code explained to me the concept behind the hyphen in that line of code. Before I couldn’t grasp what it was for.

Heh. Sorry about that. Looks like I missed commenting that in when I redid it :)
 
Upvote 0

Forum statistics

Threads
1,213,486
Messages
6,113,932
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top