Excel VBA - Date Format Conversion - date

Question

I have come across a challenging task which I am not able to solve using many workarounds.
In one column I have dates, the date can be in following three formats:
1) Simple dd/mm/yy
2) dd/mm/yy but may have words "before,after or about" around it. Any
one of it and we just need to delete those words in this case.
3) Date in a numeric format. A long decimal values like 1382923.2323
but actually I can get a date from it after conversion.
The file is uploaded here. Date_format_macro_link
I wrote the following code but it's giving wrong results.
Sub FormatDates_Mine()
ManualSheet.Activate
ManualSheet.Cells.Hyperlinks.Delete
ManualSheet.Cells.Interior.ColorIndex = xlNone
ManualSheet.Cells.Font.Color = RGB(0, 0, 0)
lastRow = ManualSheet.Range("A" & Rows.Count).End(xlUp).Row
Col = "A"
For i = 2 To lastRow
Cells(i, Col) = Trim(Replace(Cells(i, Col), vbLf, "", 1, , vbTextCompare))
If InStr(1, Cells(i, Col), "about", vbTextCompare) <> 0 Then
Cells(i, Col) = Trim(Replace(Cells(i, Col), "about", "", 1, , vbTextCompare))
Cells(i, Col).Interior.Color = RGB(217, 151, 149)
End If
If InStr(1, Cells(i, Col), "after", vbTextCompare) <> 0 Then
Cells(i, Col) = Trim(Replace(Cells(i, Col), "after", "", 1, , vbTextCompare))
Cells(i, Col).Interior.Color = RGB(228, 109, 10)
End If
If InStr(1, Cells(i, Col), "before", vbTextCompare) <> 0 Then
Cells(i, Col) = Trim(Replace(Cells(i, Col), "before", "", 1, , vbTextCompare))
Cells(i, Col).Interior.Color = RGB(228, 109, 10)
End If
DateParts = Split(Cells(i, Col), "/", , vbTextCompare)
Cells(i, Col) = Format(Cells(i, Col), "dd/mm/yyyy")
Next i
Range("D:E").HorizontalAlignment = xlCenter
End Sub
The file is uploaded here. Date_format_macro_link
Please help!

Answer 1

Is this what you are trying? I have not added any error handling. I am assuming that you will not be deviating for the existing format of your data. If the format changes then you WILL have to introduce error handling.
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long, i As Long
Dim rng As Range
Dim MyAr() As String
Set ws = ThisWorkbook.Sheets("Data")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set rng = .Range("A2:A" & lRow)
With rng
'~~> Replace "After " in the entire column
.Replace What:="After ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
DoEvents
'~~> Replace "About " in the entire column
.Replace What:="About ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.NumberFormat = "dd/mm/yyyy"
End With
For i = 2 To lRow
'~~> Remove the End Spaces
.Range("A" & i).Value = Sid_SpecialAlt160(.Range("A" & i).Value)
'~~> Remove time after the space
If InStr(1, .Range("A" & i).Value, " ") Then _
.Range("A" & i).Formula = Split(.Range("A" & i).Value, " ")(0)
'~~> Convert date like text to date
.Range("A" & i).Formula = DateSerial(Split(.Range("A" & i).Value, "/")(2), _
Split(.Range("A" & i).Value, "/")(1), _
Split(.Range("A" & i).Value, "/")(0))
Next i
End With
End Sub
Public Function Sid_SpecialAlt160(s As String)
Dim counter As Long
If Len(s) > 0 Then
counter = Len(s)
While VBA.Mid(s, counter, 1) = " "
counter = counter - 1
Wend
Sid_SpecialAlt160 = VBA.Mid(s, 1, counter)
Else
Sid_SpecialAlt160 = s
End If
End Function
Screenshot