How to check if a cell text matches the cell format.

[Macro_Nerd99]

I have a template where all the cells from A2:C10000... are formatted as a custom format: mm/dd/yyyy h:mm

However, if someone goes and messes with the formatting, it can ruin some calculations.
For example, like shown in this picture, someone can remove a space and cause the "AM" to show, which is bad. However, this change in format isn't detected in an if statement.

If .Range("A" & thisrow & ":B" & thisrow).NumberFormat = "mm/dd/yyyy h:mm" Then
Range("A" & thisrow & ":B" & thisrow).Interior.ColorIndex = 37
Else
Range("A" & thisrow & ":B" & thisrow).Interior.ColorIndex = 3
End If.

How do I add to this code below for cells to turn red if they're not displaying proper formatting (like the blue cell in the picture). ?

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
        cel.Offset(-1, 1).Interior.ColorIndex = 3
        MsgBox "Warning: There is(Are) time Lapse(s) present" & vbCrLf & "          Please fix red cells"
    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
            MsgBox "Note: End Time cannot be later than start time" & vbCrLf & "        Please fix red Cells"
        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

 

[Leo Skywalker]

Wouldn't it be easier to just fix the format for the whole range?, having scattered red cells to be manually fixed one by one is a kinda slow process.

Sub FixDateFormat()
    Range("A2:C10000").Select
    Selection.NumberFormat = "mm/dd/yyyy h:mm"
    Range("A1").Select
End Sub

Also, I am curious, since Excel treats dates as serial numbers and hours and minutes as fractions of a day, whatever the format is, would you please say which calculations could be damaged because of a different format?

 

[Macro_Nerd99]

Wouldn't it be easier to just fix the format for the whole range?, having scattered red cells to be manually fixed one by one is a kinda slow process.

Sub FixDateFormat()
    Range("A2:C10000").Select
    Selection.NumberFormat = "mm/dd/yyyy h:mm"
    Range("A1").Select
End Sub

Also, I am curious, since Excel treats dates as serial numbers and hours and minutes as fractions of a day, whatever the format is, would you please say which calculations could be damaged because of a different format?

I already tried that and it doesn't work. Like I mentioned, If someone goes and removes a space in the date, it doesn't change the format setting, it just causes and error when trying to subtract the end and start times. I end up getting a "#Value!" error when I subtract the cells in the picture.
I just wanted an error msgbox or something, upon changing the cell, to warn people that the date is written incorrectly, so when they click the button to do the calculations, that value doesn't show up as the result.

 

[NoSparks]

Anything that Excel accepts as a date will be displayed in the format the cell is set for but stored in the cell by Excel as a number.

I already tried that and it doesn't work. Like I mentioned, If someone goes and removes a space in the date, it doesn't change the format setting, it just causes and error when trying to subtract the end and start times. I end up getting a "#Value!" error when I subtract the cells in the picture.

That's because 10/10/2022 9:15:06AM (without the space) is not accepted as a date by Excel and therefore not stored as a number.
You can check for what's entered being a date in the other sub you were given

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
        'check that a date was entered
        If Not IsDate(Target.Value) Then
            Target.Select
            Target.Interior.ColorIndex = 3
            MsgBox "Excel does not accept your entry as a date"
            Exit Sub
        Else
            'it was acceptable as a date
            Call Time_Card_Validation
            'If Target.Value = "" Then Target.Interior.ColorIndex = 3
        End If
    End If
End Sub

 

[Alex Blakenburg]

You have a few options.
1) Push it back to the user by putting data validation on those 2 columns.
Enter a date range that will always work and if Excel can't translate your date/time entry as a date it will cause an error forcing the user to re-enter it.

2) The formula fails when it Excel considers it to be Text
VBA is able to translate it in many cases and is passing your IsDate test but excel is seeing it as text and the formula fails.
Test for a number using either of these 2.

Sub TestForNumeric()
    
    If Application.IsNumber(ActiveCell) Then    ' True indicates it most likely will work
        MsgBox "Works as a date"
    End If
    
    If Application.IsText(ActiveCell) Then      ' False would indicate it will work (opposite of above)
        MsgBox "It's text, will fail as a date"
    End If

End Sub

 

[Macro_Nerd99]

I figured out how I wanted it.

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
        'check that a date was entered
        If Right(Target.Text, 2) = "AM" Then
            'Target.Select
            Target.Value = Left(Target.Text, Len(Target.Text) - 2) & " AM"
            Call Time_Card_Validation
            Exit Sub
        ElseIf Right(Target.Text, 2) = "PM" Then
            Target.Value = Left(Target.Text, Len(Target.Text) - 2) & " PM"
            Call Time_Card_Validation
            Exit Sub
            
        Else
            'it was acceptable as a date
            Call Time_Card_Validation
            'If Target.Value = "" Then Target.Interior.ColorIndex = 3
        End If
    End If
End Sub

 

[Alex Blakenburg]

Thanks for the update. Glad you found a solution that worked for you.

 

[Peter_SSs]

Seems like you are only interested in that space before the AM/PM so I think this should do the same job for you?

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.CountLarge = 1 And Target.Row > 1 And Target.Column < 3 Then
    Application.EnableEvents = False 'Stops the code from needlessly recalling itself when it makes a change to the cell
    Target.Value = Replace(Replace(Target.Text, "AM", " AM"), "PM", " PM")
    Application.EnableEvents = True
    Call Time_Card_Validation
  End If
End Sub

 

[Macro_Nerd99]

I updated it even more and used a combination of both Alex's and my code:
It seems to work well, but Any feedback or recommendations are appreciated.
Thanks for everyone's help.

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Limit to single cell
    
    If Application.IsText(Target) Then
        If Target.CountLarge > 1 Then Exit Sub
        ' Limit to times
        If Target.Row > 1 And Target.Column < 3 Then
            'check that a date was entered
            If Right(Target.Text, 2) = "AM" Then
             If Right(Target.Text, 3) <> " AM" Then
                Target.Value = Left(Target.Text, Len(Target.Text) - 2) & " AM"
                Call Time_Card_Validation
          
                Exit Sub
              Else
                MsgBox "please check format"
                Target.Interior.ColorIndex = 3
                End
              End If
            ElseIf Right(Target.Text, 2) = "PM" Then
                If Right(Target.Text, 3) <> " PM" Then
            
                     Target.Value = Left(Target.Text, Len(Target.Text) - 2) & " PM"
                     Call Time_Card_Validation
                
                     Exit Sub
                Else
                    MsgBox "Please check format"
                     Target.Interior.ColorIndex = 3
                    End
                End If
            
            Else
                MsgBox "Please check format"
                End
             End If
        End If
     Else
                Call Time_Card_Validation
          
       
  
    End If
 
End Sub

 

[Peter_SSs]

Any feedback .... appreciated.

That code will error if more than one cell at a time is changed. Try selecting 2 empty cells and press the Delete key.

Any .... recommendations are appreciated.

I gave you one. Did you try it?