How to setup Time-Card Data Validation template?

[Macro_Nerd99]

I have a workbook with a Time Tracker Template for work, and I want to add data validation to it to make sure the times are calculated correctly.
For example, if an end time is before a start time, the cell turns red or gives a warning message. But also, if a start time is before the previous end time, a cell turns red.

I tried creating a large if statement in the worksheet cell change event where I loop through each row making sure it highlights any violations red, but then when it moves to the next row, it highlights it back to blue. How do you recommend fixing this?

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim ws As Worksheet
 Set ws = ThisWorkbook.Worksheets("Time Tracker Template")
 Dim start_time As Date
 Dim End_time As Date
 Dim Start_time_violation As Integer
 Dim End_Time_Violation As Integer
 Dim start_time_range As Range
 Dim end_time_range As Range
 Dim next_start_time_range As Range
 
 End_Time_Violation = 0
 Start_time_violation = 0
 
     With ws
        For i = 2 To 100
             start_time = Range("A" & i).Value
             End_time = Range("B" & i).Value
             Set next_start_time = ws.Range("A" & i + 1)
              Set start_time_rng = ws.Range("A" & i)
              Set end_time_rng = ws.Range("B" & i)
              Set next_start_time_rng = ws.Range("A" & i + 1)
             
             
             
             If start_time > 0 And End_time > 0 And next_start_time > 0 Then
                    If start_time < End_time And End_time < next_start_time Then
                        start_time_rng.Interior.Color = 16764057
                        end_time_rng.Interior.Color = 16764057
                        next_start_time_rng.Interior.Color = 16764057
                    Else
                       If start_time > End_time Then
                        start_time_rng.Interior.Color = 16764057
                        end_time_rng.Interior.ColorIndex = 3
                        End_Time_Violation = End_Time_Violation + 1
                        
                       ElseIf End_time > next_start_time Then
                        end_time_rng.Interior.Color = 16764057
                        next_start_time_rng.Interior.ColorIndex = 3
                        Start_time_violation = Start_time_violation + 1
                       Else
                            
                       End If
                    End If
                         
                ElseIf next_start_time = 0 Then
                    If start_time < End_time Then
                        start_time_range.Interior.Color = 16764057
                        end_time_range.Interior.Color = 16764057
                    Else
                        
                     End If
                End If
                
        
             
             Next i
          End With
End sub

 

[NoSparks]

I'm sure somebody will come along with conditional formatting for this but until then...
How about if you start with all blue cells and use the Worksheet_Change event to deal with only the one cell that changes and triggers the event ?
Something along the lines of this, hope the comments make sense.

Private Sub Worksheet_Change(ByVal Target As Range)
    
' Limit to single cell
If Target.CountLarge > 1 Then Exit Sub

' Limit to time columns
If Target.Column > 2 Then Exit Sub

' Limit to rows used in time columns
If Target.Row = 1 Or Target.Row > Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub

' Check entry is a date
If Target.Value <> "" And Not IsDate(Target.Value) Then
    MsgBox "That's not a date and time you entered."
    Target.Select
    Exit Sub
End If

' Deal with the changed cell for color
Select Case Target.Column
    Case Is = 1         ' it's a start time
        ' start time is OK or blank
        If Target.Value = "" Or Target.Value > Target.Offset(-1, 1).Value Then
            Target.Interior.Color = 16764057
        Else    ' start time is not OK
            Target.Interior.ColorIndex = 3
        End If
        
    Case Is = 2         ' it's an end time
        ' end time is OK or blank
        If Target.Value = "" Or Target.Value > Target.Offset(, -1) Then
            Target.Interior.Color = 16764057
        Else    ' end time is not OK
            Target.Interior.ColorIndex = 3
        End If
End Select

End Sub

 

[Macro_Nerd99]

This works pretty great, just a couple things:
1. This makes the 1st start time(cell "A2") Red regardless if it's correct or not.
2. This doesn't check if the start times are later than the previous end times(such as making sure range B2 is earlier than range A3)
3. How do I add a check to make a cell red if it is changed to blank?

Thanks for your help.

 

[Macro_Nerd99]

This works pretty great, just a couple things:
1. This makes the 1st start time(cell "A2") Red regardless if it's correct or not.
2. This doesn't check if the start times are later than the previous end times(such as making sure range B2 is earlier than range A3)
3. How do I add a check to make a cell red if it is changed to blank?

Thanks for your help.

This also only checks if the end time is greater than the start time if it's the end time that is changed. So if someone goes and changes a start time and it's not earlier than the end time in the same row, nothing turns red.

 

[NoSparks]

Yes, sorry, I'm way off.
Hopefully someone else will assist you with this.

 

[NoSparks]

Taking another look at this...

On a given row, is there only to be one of the A or B cells red ?
Or in your picture, should A4 and B4 both be red ?

 

[Macro_Nerd99]

Taking another look at this...

On a given row, is there only to be one of the A or B cells red ?
Or in your picture, should A4 and B4 both be red ?

In my picture example, both A4 and B4 should both be red because there is an overlap in time from row 3 to 4 AND the start time is later than the end time in row 4.

 

[NoSparks]

Try this in the sheet module

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Limit to single cell
    If Target.CountLarge > 1 Then Exit Sub
    ' Limit to times
    If Target.Row > 1 And Target.Column < 3 Then
        Call Time_Card_Validation
        If Target.Value = "" Then Target.Interior.ColorIndex = 3
    End If
End Sub

and this in a standard module

Option Explicit

Sub Time_Card_Validation()
    Dim lr As Long, i As Long
    Dim rng As Range, cel As Range
    Dim Stime As Date, Etime As Date, PrevEtime As Date
    
    lr = Range("A" & Rows.Count).End(xlUp).Row
    Set rng = Range("A2:A" & lr)
 
 For Each cel In rng
    ' Next 2 lines for testing
    'Stop    ' Now use F8 key
    'cel.Select
    
    If IsDate(cel.Value) Then
        ' start time
        Stime = cel.Value
        ' current end
        Etime = cel.Offset(, 1).Value
        ' previous end
        If cel.Row = 2 Then
            PrevEtime = 1
        Else
            PrevEtime = cel.Offset(-1, 1).Value
        End If
    Else
        'Exit Sub
    End If
    
    ' deal with the times
    ' start times
    If Stime <= PrevEtime Then
        cel.Interior.ColorIndex = 3
    Else
        If Stime > PrevEtime And cel.Offset(, 1) = "" Then
            cel.Interior.ColorIndex = 37
        ElseIf Stime > PrevEtime And Stime < Etime Then
            cel.Interior.ColorIndex = 37
        ElseIf Stime > PrevEtime And Stime >= Etime Then
            cel.Interior.ColorIndex = 3
        End If
    End If
    'end times
    If cel.Offset(, 1) = "" Then
        cel.Offset(, 1).Interior.ColorIndex = 37
    ElseIf Etime > Stime Then
        cel.Offset(, 1).Interior.ColorIndex = 37
    ElseIf Etime <= Stime Then
        cel.Offset(, 1).Interior.ColorIndex = 3
    End If
Next cel

End Sub

 

[Macro_Nerd99]

Try this in the sheet module

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Limit to single cell
    If Target.CountLarge > 1 Then Exit Sub
    ' Limit to times
    If Target.Row > 1 And Target.Column < 3 Then
        Call Time_Card_Validation
        If Target.Value = "" Then Target.Interior.ColorIndex = 3
    End If
End Sub

and this in a standard module

Option Explicit

Sub Time_Card_Validation()
    Dim lr As Long, i As Long
    Dim rng As Range, cel As Range
    Dim Stime As Date, Etime As Date, PrevEtime As Date
   
    lr = Range("A" & Rows.Count).End(xlUp).Row
    Set rng = Range("A2:A" & lr)
 
 For Each cel In rng
    ' Next 2 lines for testing
    'Stop    ' Now use F8 key
    'cel.Select
   
    If IsDate(cel.Value) Then
        ' start time
        Stime = cel.Value
        ' current end
        Etime = cel.Offset(, 1).Value
        ' previous end
        If cel.Row = 2 Then
            PrevEtime = 1
        Else
            PrevEtime = cel.Offset(-1, 1).Value
        End If
    Else
        'Exit Sub
    End If
   
    ' deal with the times
    ' start times
    If Stime <= PrevEtime Then
        cel.Interior.ColorIndex = 3
    Else
        If Stime > PrevEtime And cel.Offset(, 1) = "" Then
            cel.Interior.ColorIndex = 37
        ElseIf Stime > PrevEtime And Stime < Etime Then
            cel.Interior.ColorIndex = 37
        ElseIf Stime > PrevEtime And Stime >= Etime Then
            cel.Interior.ColorIndex = 3
        End If
    End If
    'end times
    If cel.Offset(, 1) = "" Then
        cel.Offset(, 1).Interior.ColorIndex = 37
    ElseIf Etime > Stime Then
        cel.Offset(, 1).Interior.ColorIndex = 37
    ElseIf Etime <= Stime Then
        cel.Offset(, 1).Interior.ColorIndex = 3
    End If
Next cel

End Sub

This works perfectly! I just made one small change for my preference but everything works how I wanted it to now! Thank you so much!

 

[NoSparks]

You're welcome, glad to have helped.