Date format testing fails

[lucpian]

Hi All,

I wrote a vba code to test if date cells in my worksheet is either mm/dd/yyyy or mm/dd/yy, and if not should color it red. However, it does not work. I do not know if it is because the cells are formatted. I also tried in the code to cpmpare the string length, but it still did not work when I fill in something shorter in length or a different format. here is the code:

Sub DateFormatChecking(columnname As Long)
Dim rowcount As Long
Dim R As Long, strVal
rowcount = Range("A65536").End(xlUp).Row
For R = 2 To rowcount
strVal = Sheet1.Cells(R, columnname).NumberFormat
'MsgBox (Len(strVal))
If strVal = Null Then
Sheet1.Cells(R, columnname).Interior.ColorIndex = 0
End If
If strVal <> "mm/dd/yyyy" And (Len(strVal)) <> 8 Then
MsgBox (Len(strVal))
If strVal <> "mm/dd/yy" And (Len(strVal)) <> 8 Then
Sheet1.Cells(R, columnname).Interior.ColorIndex = 3
'Else
' If strVal = "" Then
' Sheet1.Cells(R, columnname).Interior.ColorIndex = 0
'End If
End If
End If

Next
End Sub

I might be doing something wrong that I am not seeing or possibly my code is wrong, but is not giving me errors. Please, I would be very grateful if someone in this forum will help me out.

Thanks

Lucpian

[MikeO]

[Code]Sub DateFormatChecking(columnname As Long)
Dim rowcount As Long
Dim R As Long, strVal
rowcount = Range("A65536").End(xlUp).Row
For R = 2 To rowcount
strVal = Sheet1.Cells(R, columnname).NumberFormat
If strVal <> "mm/dd/yyyy" And strVal <> "mm/dd/yy" Then
Sheet1.Cells(R, columnname).Interior.ColorIndex = 3
Else
Sheet1.Cells(R, columnname).Interior.ColorIndex = 0
End If
Next
End Sub
[/Code

[lucpian]

Effective Date8/6/08/06/200708/06/200708/06/200708/06/200708/06/200708/06/200708/06/200708/06/200708/08/200708/08/200708/08/200708/17/200708/17/200708/17/200708/17/200708/17/200708/20/200708/20/200708/20/2007Thanks Mike, however, the modification to my code you gave still does not work. When you test the code against the above data, you do not have the red color showing in the first cell which should if it was working.

Thanks

Lucpian

[MikeO]

What row is the first cell in? You had "R = 2 to rowcount", so I assumed the data started in row 2.

[lucpian]

Hi Mike,

The first data was in the second row and I basically entered 8/2/ and expected that when I ran the code it should color it red, but it does not.

Thanks

Lucpian

[MikeO]

Ah, I see now. Try this, hope it works for you:

Sub DateFormatChecking(columnname As Long)
    Dim rowcount As Long
    Dim R As Long, strVal
    Dim String1 As String
    Dim String2 As String
    rowcount = Range("A65536").End(xlUp).Row
    For R = 2 To rowcount
         strVal = Sheet1.Cells(R, columnname).NumberFormat
         String1 = Sheet1.Cells(R, columnname).Value
         String2 = Sheet1.Cells(R, columnname).Value2
         If String1 <> String2 Then
             If strVal <> "mm/dd/yyyy" And strVal <> "mm/dd/yy" Then
                 Sheet1.Cells(R, columnname).Interior.ColorIndex = 3
             Else
                 Sheet1.Cells(R, columnname).Interior.ColorIndex = 0
             End If
         Else
             Sheet1.Cells(R, columnname).Interior.ColorIndex = 3
         End If
    Next
End Sub

[MikeO]

Disregard my last post...here's a better method:

Sub DateFormatChecking(columnname As Long)
    Dim rowcount As Long
    Dim R As Long, strVal
    rowcount = Range("A65536").End(xlUp).Row
    For R = 2 To rowcount
        strVal = Sheet1.Cells(R, columnname).NumberFormat
        If IsDate(Sheet1.Cells(R, columnname)) Then
            If strVal <> "mm/dd/yyyy" And strVal <> "mm/dd/yy" Then
                Sheet1.Cells(R, columnname).Interior.ColorIndex = 3
            Else
                Sheet1.Cells(R, columnname).Interior.ColorIndex = 0
            End If
        Else
            Sheet1.Cells(R, columnname).Interior.ColorIndex = 3
        End If
    Next
End Sub

[mdmackillop]

Hi Mike,
Set all cells clear first to simplify your code