Excel VBA - Date Format Conversion
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
Comments
-
TechGeek almost 2 years
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!
-
Our Man in Bananas about 11 years+1 for Sid_SpecialAlt160 (and screenshots) and it works, but couldn't this be solved using worksheet formulas?
-
TechGeek about 11 years@SiddharthRout: Sorry but I don't this is what I want. I want each and every date to be converted in mm/dd/yy. If you see cell A1, before it was dd/m/yyyy and after it is dd/mm/yy. You got my point? Thanks and please give it a try again
-
Siddharth Rout about 11 years@Tejas: If you want it as
mm/dd/yy
then simply change the line.NumberFormat = "dd/mm/yyyy"
in my above code to.NumberFormat = "mm/dd/yy"
. I chose "dd/mm/yyyy" because you did the same in your code in your question ;)