[RESOLVED] DateDiff

[tome10]

Can someone help with this? It doesn't error, but it doesn't work either.

1. I don't think it's cycling through the cells, but I don't know how to make it.
2. It doesn't work
It should look at the date, compare with current and set the Font.

      Sub DateText()

           Dim ws As Worksheet, dCell As Range
           Set ws = Sheets("LD")
           Set dCell = ws.Range("B6:B82")
           '- the number of days between today and the doc date
           '- NOTE: the "d" tells the DateDiff function to return the difference
           '- in days
           numOfDays = DateDiff("d", dToday, dCell.Text)
           '- with blocks simply save typing... here it applies everywhere you see
           '- .Font (it really means dCell.Font.ColorIndex = 3
           With dCell.Font
           '- i think the select statement is faster than a large if statement
           Select Case (numOfDays)
           '- if the doc date is within a week of today...
           '- Two Weeks
           Case Is <= 14
           '- ... yellow
           .ColorIndex = 6
           '-One Week
           Case Is <= 7
           '- ... Red
           .ColorIndex = 3

       End Select

       End With

      'On Error GoTo 0

       End Sub

[Pradeep1210]

 numOfDays = DateDiff("d", dToday, dCell.Text)

I think this just takes the text of first cell in the range.

[westconn1]

as far as i can see here dtoday has no value of any type, it may have been declared and set elsewhere, which is fine as long as it is still in scope

Set dCell = ws.Range("B6:B82")

this is a range of cells so as pradeep says you can not compare a range with differing values in one go

try like

for each dcell in ws.range("b6:b82")
' your comparing, colouring code
next

[tome10]

as far as i can see here dtoday has no value of any type, it may have been declared and set elsewhere, which is fine as long as it is still in scope

I thought it was a "Built In" name representing todays date internally.
Maybe like

numOfDays = DateDiff("d", dToday(), dCell.Text)

But I got this code from a Resolved thread, and they didn't have anything like
Dim dToday = dToday()
listed anywhere. So I don't know.

for each dcell in ws.range("b6:b82")

	

		

			

			
				' your comparing, colouring code
			
		
	
next

Well, I'm not comparing the colouring..
I'm trying to:
1. dcells contains dates 10/22/09
2. DateDiff is supposedly to compare the date in the Cell with the Internal Computer Date.?.? And bring back the difference in "d"Days.
Then the Case statement is supposed to "Set" the Cell "Text" Colour.
Basically I'm trying to build an alarm system: Yellow= "Deadline is Approaching" Red= "You have a Week" kinda thing.

[westconn1]

I thought it was a "Built In" name representing todays date internally.

date or now are built in functions to return the current date or date/time

Well, I'm not comparing the colouring..

well read that as
your code to compare the dates and set the colouring
that is the code you posted before put inside the loop, you can then see if you get a correct result or if there is some other issues as well

[Pradeep1210]

I thought it was a "Built In" name representing todays date internally.
Maybe like

But I got this code from a Resolved thread, and they didn't have anything like
Dim dToday = dToday()
listed anywhere. So I don't know.

If you need current date, you can use the Date() function.
e.g.
numOfDays = DateDiff("d", Date(), dCell.Text)

for each dell in ws.range("b6:b82")

next

Well, I'm not comparing the colouring..
I'm trying to:
1. dcells contains dates 10/22/09
2. DateDiff is supposedly to compare the date in the Cell with the Internal Computer Date.?.? And bring back the difference in "d"Days.
Then the Case statement is supposed to "Set" the Cell "Text" Colour.
Basically I'm trying to build an alarm system: Yellow= "Deadline is Approaching" Red= "You have a Week" kinda thing.

I think he meant like this:

Sub DateText()
 
           Dim ws As Worksheet, dCell As Range
           Set ws = Sheets("LD")
    For Each dCell in ws.Range("b6:b82")
 
           ' Set dCell = ws.Range("B6:B82")
           '- the number of days between today and the doc date
           '- NOTE: the "d" tells the DateDiff function to return the difference
           '- in days
           numOfDays = DateDiff("d", Date(), dCell.Text)
           '- with blocks simply save typing... here it applies everywhere you see
           '- .Font (it really means dCell.Font.ColorIndex = 3
           With dCell.Font
           '- i think the select statement is faster than a large if statement
           Select Case (numOfDays)
           '- if the doc date is within a week of today...
           '- Two Weeks
           Case Is <= 14
           '- ... yellow
           .ColorIndex = 6
           '-One Week
           Case Is <= 7
           '- ... Red
           .ColorIndex = 3
 
       End Select
 
       End With
    Next
 
      'On Error GoTo 0
 
       End Sub

[Siddharth Rout]

Do you want to do this in VBA or through formulas?

You can achieve what you want by using Formulas + use of conditional formatting

Going by your first post (Range is B6:B82), Put this formula in C6 if it is empty and drag it down till C82...

=DATEDIF(B6,TODAY(),"d")

For the Conditional formatting, check my signature...

[tome10]

I need it in VBA Sid.
This works.. Except for the case statements
They should be:
Case 0 To 7
Case 8 to 14
Also, what would be the best way to set the Range("A:I").Font
Clarify, Instead of just the dCell text coloured I would like all text in the same row "Except for Col A".

[westconn1]

dcell.entirerow.font.colorindex = 3
dcell.offset(0,-1).font.colorindex = -4105  ' default

or better

range(dcell,dcell.offset(0,7)).font.colorindex = 3

[tome10]

This is basically the same thing but different range and I am setting the Interrior Color Index. I can't figure out why it won't work. I think it is the Case statement, but I've tried a few different ways and noting.

Private Sub ProjStat()
        Dim ws As Worksheet, psCell As Range
        Set ws = Sheets("LD")
        For Each psCell In ws.Range("C6:C82")

        pStat = psCell.Text

        With Range(psCell, psCell.Offset(-1, 6)).Interior

        Select Case (pStat)
        Case "Pan"
        .ColorIndex = 1
        Case "Decom"
        .ColorIndex = 2
        Case Is = "Hot"
        .ColorIndex = 3
        Case "Complete"
        .ColorIndex = 4
        End Select
        End With
        Next
        'On Error GoTo 0
    End Sub

[westconn1]

i can not see any problem with the code
what happens?
are you sure the cells contain nothing except the what is in the case statements
you could add a case else for testing

Select Case (pStat)
        Case "Pan"
        .ColorIndex = 1
        Case "Decom"
        .ColorIndex = 2
        Case Is = "Hot"
        .ColorIndex = 3
        Case "Complete"
        .ColorIndex = 4
        case else
            msgbox pstat
        End Select

[tome10]

I got it thanks to the Else MsgBox. I had the words in the Cell CAPS, and the Case Non Caps.
I Can't figure out how to color the cell to the left of the psCell.

With Range(psCell, psCell.Offset(0, 6)).Interior

The 0 counts the Rows. Don't want that.
The 6 Counts 6 to the right.
How do you do Offset Left -2
I need ("A:I")



Also,
It looks like I need an If or Case statement that takes Precedent over This Case Statement.
It has to look at the Date Range ColB/-1 and If "" "Blank" color the interior something else. Disregard the other Case Statements.

[westconn1]

you would have to do 2 offsets

range(pscell.offset(,-2),pscell.offset(,6)).interior

[tome10]

This is my best shot.

    Private Sub ProjStat()
        Dim ws As Worksheet, psCell As Range
        Set ws = Sheets("LD")
        For Each psCell In ws.Range("C6:C82")

        dStat = psCell.Offset(0, -1).Value
        pStat = psCell.Value
        
        If dStat <> "" Then 'This looks like an If to me
        With Range(psCell, psCell.Offset(0, 6)).Interior
        'Date:Green4, NoDate:Yellow6,
        Select Case (dStat)
        Case Is <> ""
        .ColorIndex = 4
        Case Is ""
        .ColorIndex = 6
        Case Else
            MsgBox dStat
        End Select
        
        Else: Select Case pStat 'Errors here Else without If
        'Pan:Blue8, Decom:Plum39, Hot:Red3
        Case "PAN"
        .ColorIndex = 8
        Case "DECOM"
        .ColorIndex = 39
        Case "HOT"
        .ColorIndex = 3
        Case "COMPLETE"
        .ColorIndex = 35
        Case Else
            MsgBox pStat
        End Select
        End With
        End If
        Next
        'On Error GoTo 0
    End Sub

[westconn1]

your end with is in a different code block to the with, one in if the other in else
either move right outside the if/else code or have one for each

[tome10]

your end with is in a different code block to the with, one in if the other in else

I thought I was "Sharing" the With between the Two CodeBlocks. I actually thought that was just "One" code block because The IF and Else go together but I guess that's not the case.

either move right outside the if/else code or have one for each

What do you mean Move "Right" Outside?
Like this?

With Range(psCell, psCell.Offset(0, 6)).Interior
If dStat <> "" Then 'This looks like an If to me

[tome10]

Alright, new train of thought. I am going to attempt to combine these 2 codes since they are so similiar.

Private Sub ProjStat()
        Dim ws As Worksheet, psCell As Range
        Set ws = Sheets("LD")
        For Each psCell In ws.Range("C6:C82")

        pStat = psCell.Text

        With Range(psCell.Offset(0, -2), psCell.Offset(0, 6)).Interior

        Select Case (pStat)
        'Pan:Blue8, Decom:Plum39, Hot:Red3
        Case "PAN"
        .ColorIndex = 8
        Case "DECOM"
        .ColorIndex = 39
        Case Is = "HOT"
        .ColorIndex = 3
        Case "COMPLETE"
        .ColorIndex = 4
        End Select
        End With
        Next
        'On Error GoTo 0
    End Sub

    Private Sub ProjDate()
        Dim ws As Worksheet, dCell As Range
        Set ws = Sheets("LD")
        For Each dCell In ws.Range("B6:B82")
        numOfDays = DateDiff("d", Date, dCell.Value)
        With Range(dCell, dCell.Offset(0, 7)).Font
        Select Case (numOfDays)
        '-5-10 Days
        Case 5 To 10
        '-Yellow6
        .ColorIndex = 6
        '1-4 Days
        Case 1 To 4
        '-Red3
        .ColorIndex = 3
        Case Is <= 0
        '-Red3
        .ColorIndex = 3
'        Case Else
'            MsgBox pStat
        End Select
        End With
        Next
        'On Error GoTo 0
    End Sub

[westconn1]

you can put the for each in the second sub immediately after the next in the first sub

[tome10]

I combined the 2 codes. But I have an issue.
This code does the operations seperately.
It seems I need to be able to compare the 2 Ranges at the same time.
Is there a way to set the pCell, and the dCell Whereas dCell is just the Offset 0,-1.Value? For use as a Case dCell<>"" and pCell "Something"
I can use Case "this" And "that" can't I? Or is "And" an If thing?

        Private Sub ProjStat()
        Dim ws As Worksheet, psCell As Range, dCell As Range
        Set ws = Sheets("LD")
        For Each psCell In ws.Range("C6:C82")
        pStat = psCell.Text
        With Range(psCell.Offset(0, -2), psCell.Offset(0, 6)).Interior
        Select Case (pStat)
        'Pan:Blue8,Decom:Plum39,Hot:Red3,"":Green4,Complete:Purp/Gray47
        Case "PAN"
        .ColorIndex = 8
        Case "DECOM"
        .ColorIndex = 39
        Case Is = "HOT"
        .ColorIndex = 3
        Case "COMPLETE"
        .ColorIndex = 47
        Case ""
        .ColorIndex = 4
'        Case Else
'            MsgBox pStat
        End Select
        End With
        Next
        'On Error GoTo 0
        For Each dCell In ws.Range("B6:B82")
        numOfDays = DateDiff("d", Date, dCell.Value)
        With Range(dCell, dCell.Offset(0, 7)).Font
        Select Case (numOfDays)
        '5-10:Yellow6,1-4:Red3,<=0:Red3,"":Green4,
        Case Is >= 11
        .ColorIndex = 0
        Case 5 To 10
        .ColorIndex = 6
        Case 1 To 4
        .ColorIndex = 3
        Case Is <= 0
        .ColorIndex = 3
'        Case Else
'            MsgBox dStat
        End Select
        End With
        Next
        'On Error GoTo 0
    End Sub

[westconn1]

try like this then, but as you still have to have 2 select case it makes only small difference

Private Sub ProjStat()
        Dim ws As Worksheet, psCell As Range, dCell As Range
        Set ws = Sheets("LD")
        For Each dCell In ws.Range("B6:B82")
        numOfDays = DateDiff("d", Date, dCell.Value)
 
        Select Case (numOfDays)
        '5-10:Yellow6,1-4:Red3,<=0:Red3,"":Green4,
        Case Is >= 11
        fcol= 0
        Case 5 To 10
        fcol= 6
        Case 1 To 4
        fcol= 3
        Case Is <= 0
        fcol= 3
'        Case Else
'            MsgBox dStat
        End Select
        select case dcell.offset(,1)
        Case "PAN"
        icol= 8
        Case "DECOM"
        icol= 39
        Case Is = "HOT"
        icol= 3
        Case "COMPLETE"
        icol= 47
        Case ""
        icol= 4
        end select
        Next
       with Range(dCell, dCell.Offset(0, 7))
       .font.colorindex = fcol
       .interior.colorindex = icol
       end with

not tested, may need minor alterations

[anhn]

@pete, I know you said "not tested" but not easy for the OP to figure out: the "With" block needs to be moved to inside the ForNext block.

Foreground and Background colors need to be chosen carefully. They should not share a same value and should be easy to read.

Private Sub ProjStat()
    Dim dCell As Range
    Dim fcol As Long, icol As Long
    
    For Each dCell In Sheets("LD").Range("B6:B82")
        Select Case DateDiff("d", Date, dCell.Value)
            Case Is >= 11:    fcol = 3  '0
            Case Is >= 5:     fcol = 5  '6 '-- 5 to 10
            Case Else:        fcol = 10 '3 '-- < 5
        End Select
        Select Case dCell.Offset(0, 1)
            Case "PAN":       icol = 40 '34 '8
            Case "DECOM":     icol = 6  '35 '39
            Case "HOT":       icol = 44 '36 '3
            Case "COMPLETE":  icol = 34 '37 '47
            Case Else:        icol = 37 '40 '4
        End Select
        With dCell.Resize(1, 7) '-- this is the same but much simpler than
                                '   Sheets("LD").Range(dcell, dcell.offset(0,7))
            .Font.ColorIndex = fcol
            .Interior.ColorIndex = icol
        End With
    Next
End Sub

Learn how to use proper code indents that will be easier to read and less errors.

[tome10]

Anhn,

Foreground and Background colors need to be chosen carefully. They should not share a same value and should be easy to read.

That's what I'm trying to figure out right now.
I need to go like
Case dCell<>"" And pCell ="Pan" Color something
Case dcell="" And pCell="Pan" Color something else

With dCell.Resize(1, 7) '-- this is the same but much simpler than

Hmm.. I would look at that and think it was Resizing the Cell. Does the 1 represent the Column?

[tome10]

Can someone advise. If Case "this" And "that" is legit?
And what this actually is doing?

With dCell.Resize(1, 7)

[tome10]

I just pasted Anhn's code in a module and it retained the formatting. Did someone change something?

[tome10]

I can't figure out what the 1 represents in this. It errors when I put a 0 or -1.

With dCell.Resize(1, 8)

Also, I need the Fill Interior A:I right now it only goes B:I, and i'm not sure how to fix that.
Also, the Font Color Syntax can't share the same range with the Interior Color Syntax as Column A has Blue Hyperlinks.
The if statement I put in isn't working either.
I need the IF because When Date is in alarm, and Stat is Hot I end up having Red Background, and Red Font. I need to change the Font to white in that situation. I'm just having a terrible time figuring it all out. I just need a bunch of If and Statements. Maybe because I always used embedded Formula's and I would Concatenate lots of If statements i'm just not getting the Case Statements. I was also thinking of formatting the Stat cell with a Windings Font when the date was in alarm. So should I abandon the Case statements? Maybe I just need sleep.

Private Sub ProjStat()
    Dim dCell As Range
    Dim fcol As Long, icol As Long
    
    For Each dCell In Sheets("LD").Range("B6:B82")
        Select Case DateDiff("d", Date, dCell.Value)
            '<=0:Red3,1-4:Red3,5-10:Yellow6,
            Case Is >= 11:    fcol = 0
            Case Is >= 5:     fcol = 6
            Case Is >= 0:     fcol = 3
            Case Is < 0:      fcol = 3
            Case Else:        fcol = 0
        End Select
        If dCell.Offset(0, 1) = "HOT" Then
        Select Case DateDiff("d", Date, dCell.Value)
            '<=0:White1,1-4:White1,5-10:Yellow6,
            Case Is >= 11:    fcol = 0
            Case Is >= 5:     fcol = 6
            Case Is >= 0:     fcol = 1
            Case Is < 0:      fcol = 1
            Case Else:        fcol = 0
        End Select
        End If
        Select Case dCell.Offset(0, 1)
            'Pan:Blue8,Decom:Plum39,Hot:Red3,"":Green4,Complete:Purp/Gray47
            Case "PAN":       icol = 8
            Case "DECOM":     icol = 39
            Case "HOT":       icol = 3
            Case "COMPLETE":  icol = 47
            Case Else:        icol = 4
        End Select
        With dCell.Resize(1, 8) '-- this is the same but much simpler than
                                '   Sheets("LD").Range(dcell, dcell.offset(0,7))
            .Font.ColorIndex = fcol
            .Interior.ColorIndex = icol
        End With
    Next
End Sub

[tome10]

Please?

[westconn1]

try like
Case "HOT": icol = 3: fcol = 1

[tome10]

Alright, i'm back. I have this working mostly, but I can't seem to get the Interrior Color macro to color the A column of the Rows. I never could figure out what dCell.Resize(1, 8) was doing.
The font color needs to affect Col B:I
The Interrior color needs to affect A:I

 Sub ProjStat()
    
    Dim dCell As Range
    Dim fcol As Long, icol As Long
    'Set dCell = dCell              'dCell=Date Cell
    'Set sCell = dCell.Offset(0, 1) 'sCell=Status Cell
         
        For Each dCell In Sheets("LD").Range("B6:B82")
        If dCell.Offset(0, 1) = "PAN" Then
        Select Case DateDiff("d", Date, dCell.Value)
          '<=0:Red3,1-4:White2,5-10:Yellow6,BLACK0,
            Case Is >= 11:    fcol = 0
            Case Is >= 5:     fcol = 6
            Case Is >= 0:     fcol = 3
            Case Is < 0:      fcol = 3
        End Select
        End If
        If dCell.Offset(0, 1) = "DECOM" Then
        Select Case DateDiff("d", Date, dCell.Value)
          '<=0:Red3,1-4:White2,5-10:Yellow6,BLACK0,
            Case Is >= 11:    fcol = 0
            Case Is >= 5:     fcol = 6
            Case Is >= 0:     fcol = 3
            Case Is < 0:      fcol = 3
        End Select
        End If
        If dCell.Offset(0, 1) = "HOT" Then
        Select Case DateDiff("d", Date, dCell.Value)
          '<=0:Red3,1-4:White2,5-10:Yellow6,
            Case Is >= 11:    fcol = 0
            Case Is >= 5:     fcol = 6
            Case Is >= 0:     fcol = 2
            Case Is < 0:      fcol = 2
        End Select
        End If
        If dCell.Offset(0, 1) = "COMPLETE" Then
        Select Case DateDiff("d", Date, dCell.Value)
          '<=0:Red3,1-4:White2,5-10:Yellow6,
            Case Is >= 11:    fcol = 0
            Case Is >= 5:     fcol = 0
            Case Is >= 0:     fcol = 0
            Case Is < 0:      fcol = 0
        End Select
        End If
        If dCell.Offset(0, 1) = "" Then
        Select Case DateDiff("d", Date, dCell.Value)
            '<=0:Red3,1-4:Red3,5-10:Yellow6,>11:Black0,
            Case Is >= 11:    fcol = 0
            Case Is >= 5:     fcol = 6
            Case Is >= 0:     fcol = 3
            Case Is < 0:      fcol = 3
        End Select
        End If
        If dCell <> "" Then
        Select Case dCell.Offset(0, 1)
            'Pan:Blue8,Decom:Plum39,Hot:Red3,"":Green4,Complete:Gray15
            Case "PAN":       icol = 8
            Case "DECOM":     icol = 39
            Case "HOT":       icol = 3
            Case "COMPLETE":  icol = 15
            Case Else:        icol = 4
        End Select
        End If
        If dCell = "" Then
        Select Case dCell.Offset(0, 1)
            'Pan:Blue8,Decom:Plum39,Hot:Red3,"":Green4,Complete:Purp/Gray47,NoDates:Yellow6,
            Case "PAN":       icol = 8
            Case "DECOM":     icol = 39
            Case "HOT":       icol = 3
            Case "COMPLETE":  icol = 15
            Case Else:        icol = 6
        End Select
        End If
        With dCell.Resize(1, 8) '-- this is the same but much simpler than
                                '   Sheets("LD").Range(dcell, dcell.offset(0,7))
            .Font.ColorIndex = fcol
            .Interior.ColorIndex = icol
        End With
    
    Next
End Sub