extract date but exclude Time

[rikvny02]

Hello All
The code below extracts the dates needed. However, there are instances when Time (1:00a) is entered into column C. How can I eliminate the conversion of time into a date? Please see last row results. Thanks for the help.

Dates	Results
03-Dec-2023​	12/03/23​
02-Dec-2023​	12/02/23​
omit 12/3	12/03/23​
12/3 omit	12/03/23​
1:00a	01/00/00​

Sub DateExtract()
Dim rng As Range, R As Range
Dim I As Long
Dim S As String
Dim SA As Variant
Dim D As Date

With ActiveSheet
Set rng = .Range("c2", .Range("c" & .Rows.Count).End(xlUp))
rng.Offset(0, 1).NumberFormat = "mm/dd/yy"
End With

For Each R In rng
S = Application.Trim(R.Value)
SA = Split(S, " ")
For I = LBound(SA) To UBound(SA)
SA(I) = Replace(SA(I), ".", "-")
If VBA.IsDate(SA(I)) Then
D = CDate(SA(I))
If Len(Year(D)) < 4 Then
D = VBA.DateSerial(Year(Date), Month(D), Day(D))
End If
R.Offset(0, 1).Value = CStr(D)
End If
Next I
Next R
End Sub

 

[rjtaylor]

If your data always has the format of 01:00a or 1:00p you can simply add an Iff statment like...

If Right(S, 1) = "a" Or Right(S, 1) = "p" Then
    Else

end if

Here is the full example

Sub DateExtract()
Dim rng As Range, R As Range
Dim I As Long
Dim S As String
Dim SA As Variant
Dim D As Date

With ActiveSheet
Set rng = .Range("c2", .Range("c" & .Rows.Count).End(xlUp))
rng.Offset(0, 1).NumberFormat = "mm/dd/yy"
End With

For Each R In rng
    S = Application.Trim(R.Value)
    If Right(S, 1) = "a" Or Right(S, 1) = "p" Then
    Else
        SA = Split(S, " ")
        For I = LBound(SA) To UBound(SA)
            SA(I) = Replace(SA(I), ".", "-")
            If VBA.IsDate(SA(I)) Then
                D = CDate(SA(I))
                If Len(Year(D)) < 4 Then
                    D = VBA.DateSerial(Year(Date), Month(D), Day(D))
                End If
                R.Offset(0, 1).Value = CStr(D)
            End If
        Next I
    End If
Next R
End Sub

 

[rikvny02]

If your data always has the format of 01:00a or 1:00p you can simply add an Iff statment like...

If Right(S, 1) = "a" Or Right(S, 1) = "p" Then
    Else

end if

Here is the full example

Sub DateExtract()
Dim rng As Range, R As Range
Dim I As Long
Dim S As String
Dim SA As Variant
Dim D As Date

With ActiveSheet
Set rng = .Range("c2", .Range("c" & .Rows.Count).End(xlUp))
rng.Offset(0, 1).NumberFormat = "mm/dd/yy"
End With

For Each R In rng
    S = Application.Trim(R.Value)
    If Right(S, 1) = "a" Or Right(S, 1) = "p" Then
    Else
        SA = Split(S, " ")
        For I = LBound(SA) To UBound(SA)
            SA(I) = Replace(SA(I), ".", "-")
            If VBA.IsDate(SA(I)) Then
                D = CDate(SA(I))
                If Len(Year(D)) < 4 Then
                    D = VBA.DateSerial(Year(Date), Month(D), Day(D))
                End If
                R.Offset(0, 1).Value = CStr(D)
            End If
        Next I
    End If
Next R
End Sub

Thanks for the help