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

 

[Macro_Nerd99]

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


I gave you one. Did you try it?

Thank you for the feedback...That's great to know! How do you recommend preventing that error then?

 

[Peter_SSs]

How do you recommend preventing that error then?

Try my code.

 

[Macro_Nerd99]

Try my code.

I don't understand your code enough to know exactly how to fit that into my existing updated code with all the other if statements I added.

 

[Macro_Nerd99]

I changed it to this and it seemed to not crash anymore:

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 Application.IsText(Target) Then
            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
                ' If Target.Value = "" Then Target.Interior.ColorIndex = 3
                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
                    '  If Target.Value = "" Then Target.Interior.ColorIndex = 3
                     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
              '  If Target.Value = "" Then Target.Interior.ColorIndex = 3
           
      
    End If
    
End Sub

 

[mikerickson]

I think you are using the sledgehammer of a Change event to swat the fly that Data Validation would fix.

 

[Leo Skywalker]

I think you are using the sledgehammer of a Change event to swat the fly that Data Validation would fix.

Totally agree, just have the user input a correct date.

 

[Macro_Nerd99]

Totally agree, just have the user input a correct date.

You obviously didn't understand my issue from the beginning.
I explained that I have a template that has dates + times in it, and when people go messing around with a template it can ruin the formats of dates and ruin calculations.(I've seen it happen already with people at work.) It technically doesn't change the formatting of the cell/range it changes the value from a number to a text, and that's what ruins calculations!

I have a button on the ws that inputs the date + time in a cell when you click it, but if people want to change it and make an error, my other button that calculates the difference between the dates gives me an invalid value, and so I wanted to PREVENT that issue BEFORE they click the 2nd button!!!

People are human and make errors, so they won't always input a correct date + time!
So your advice is useless!

 

[Leo Skywalker]

You obviously didn't understand my issue from the beginning.
I explained that I have a template that has dates + times in it, and when people go messing around with a template it can ruin the formats of dates and ruin calculations.(I've seen it happen already with people at work.) It technically doesn't change the formatting of the cell/range it changes the value from a number to a text, and that's what ruins calculations!

I have a button on the ws that inputs the date + time in a cell when you click it, but if people want to change it and make an error, my other button that calculates the difference between the dates gives me an invalid value, and so I wanted to PREVENT that issue BEFORE they click the 2nd button!!!

People are human and make errors, so they won't always input a correct date + time!
So your advice is useless!

You obviously need to read a bit about data validation. It prevents users from entering wrong data and "messing around"; as mikerickson said, trying to kill a fly with a missile.
Have a good night.

 

[Peter_SSs]

I don't understand your code enough to know exactly how to fit that into my existing updated code with all the other if statements I added.

Why don't you just humour me for a moment and try my code instead of yours. It may not do everything that you want, but let's see if at least it fixes the 'removing space' issue that you initially talked about. If it is headed in the right direction but needs tweaking a bit then we can see if that is possible.

In relation to the VBA v Data Validation issue, my 2 cents worth is: Data validation can easily be defeated if the user pastes data. VBA can easily be defeated if a user does not enable macros.
In my view, whoever is controlling the workbook has to decide what is most appropriate for their situation and user(s).

 

[Macro_Nerd99]

Data validation can easily be defeated if the user pastes data.

Thanks for adding that too. That's also important to know!

Why don't you just humour me for a moment and try my code instead of yours.

I did try your code and it does work well at fixing the "no space" issue. I also DID add Data validation to my template. But it's good to know there is also code to check for errors for when data is pasted instead of typed.