Text to Date Conversion

peelamedu_bulls

New Member
Joined
Nov 30, 2005
Messages
29
I have a column that has an extra "1" at the start. The requirement is to strip that extra character/number and convert the date to a MM/DD/YYYY format.

Column A
1140430
1141124
1140403

Column A
14/04/2030
14/11/2024
14/04/2003

is there a VBA way to do this, preferably without creating any new column and do this manipulation in the same Column A
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Code:
Option Explicit


Sub foo()
    Dim lr As Long, i As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To lr
        Range("A" & i) = Right(Range("A" & i), 6)
        Range("A" & i) = Left(Range("A" & i), 2) & "/" & Mid(Range("A" & i), 3, 2) & "/" & Right(Range("A" & i), 2)
    Next i
End Sub
 
Upvote 0
Code:
Sub Main()
    Dim r As Range, a, i As Long
    
    Set r = Range("A2", Cells(Rows.Count, "A").End(xlUp))
    a = WorksheetFunction.Transpose(r)
    
    On Error Resume Next
    For i = 0 To UBound(a)
        a(i) = Right(a(i), 6)
        Debug.Print i, a(i)
        '1140430, 14/04/2030
        a(i) = DateSerial(Right(a(i), 2), Mid(a(i), 3, 2), Left(a(i), 2))
    Next i
    
    r = WorksheetFunction.Transpose(a)
    r.NumberFormat = "dd/mm/yyyy"
End Sub
 
Upvote 0
Just another way:

Code:
[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1109270a()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1109270-text-date-conversion.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] c [COLOR=Royalblue]As[/COLOR] Range, x [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]
Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
    [COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] c [COLOR=Royalblue]In[/COLOR] Range([COLOR=brown]"A1"[/COLOR], Cells(Rows.count, [COLOR=brown]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))
       
        [COLOR=Royalblue]If[/COLOR] IsNumeric(c) [COLOR=Royalblue]And[/COLOR] Len(c) = [COLOR=crimson]7[/COLOR] [COLOR=Royalblue]Then[/COLOR]
            x = Right(c, [COLOR=crimson]6[/COLOR])
            c = DateSerial(Right(x, [COLOR=crimson]2[/COLOR]), [COLOR=Royalblue]Mid[/COLOR](x, [COLOR=crimson]3[/COLOR], [COLOR=crimson]2[/COLOR]), Left(x, [COLOR=crimson]2[/COLOR]))
        [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
   
    [COLOR=Royalblue]Next[/COLOR]
Range([COLOR=brown]"A1"[/COLOR], Cells(Rows.count, [COLOR=brown]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp)).NumberFormat = [COLOR=brown]"MM/DD/YYYY"[/COLOR]
Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]
 
Last edited:
Upvote 0
A shorter, faster sub that correctly converts 1140430 into 14/04/2030:
Code:
Sub Txt2Date()
    Dim Rng As Range
    Set Rng = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    Rng = Evaluate("INDEX(REPLACE(RIGHT(" & Rng.Address & ",6),5,0,20),0)")
    Rng.TextToColumns , xlDelimited, , , , , , , , , Array(1, 4)
    Rng.NumberFormat = "dd/mm/yyyy"
End Sub
 
Upvote 0
A shorter, faster sub that correctly converts 1140430 into 14/04/2030:
Code:
Sub Txt2Date()
    Dim Rng As Range
    Set Rng = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    Rng = Evaluate("INDEX(REPLACE(RIGHT(" & Rng.Address & ",6),5,0,20),0)")
    Rng.TextToColumns , xlDelimited, , , , , , , , , Array(1, 4)
    Rng.NumberFormat = "dd/mm/yyyy"
End Sub
Here is another way to write a non-looping macro for the OP. I am not sure, but I think VBA/Excel will end up doing less work overall using this code.
Code:
Sub Txt2Date()
  Dim Addr As String
  Addr = "A1:A" & Cells(Rows.Count, "A").End(xlUp).Row
  Range(Addr) = Evaluate(Replace("IF({1},TEXT(RIGHT(REPLACE(RIGHT(@,6),5,0,MID(@,2,2)&20),8),""00\/00\/0000""))", "@", Addr))
  Range(Addr).NumberFormat = "dd/mm/yyyy"
End Sub
 
Upvote 0
This is a mute point since the op has not responded. If the dates are always expected to be year 2000+, posts #5 and #6 are fine. Two digit year dates can be a problem for some routines.
 
Last edited:
Upvote 0
For giggles, I did a few times tests. The suffix number is the code in that post number.

Txt2Date3 0.501302083
Txt2Date5 1.44140625
Txt2Date6 2.063802083

Code:
Sub Avg3RunTimes()
    Dim d As Double, dd As Double
    Dim s As String
    Dim j As Integer, k As Integer
    Dim jj As Integer, kk As Integer
    
    jj = 3    'Number of single runs.
    kk = 3  'Number of replicate runs
    
    For k = 1 To kk 'Replicate runs
        For j = 1 To jj 'Single runs
            s = "Txt2Date" & Choose(j, 3, 5, 6)
            Fill100kRows
            d = Timer
            Application.Run s
            dd = Timer
            Debug.Print s, dd - d & " seconds."
        Next j
    Next k
End Sub

Sub Fill100kRows()
    Range("A2:A100001").Clear
    Range("A2") = ""
    Range("A3") = 1140499
    Range("A4:A100001") = 1140403
End Sub
 
Upvote 0
Here is an even faster sub:
Code:
Sub Txt2Date_v2()
    Dim Rng As Range
    Set Rng = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    Rng = Evaluate("INDEX(REPLACE(" & Rng.Address & ",6,0,20),0)")
    Rng.TextToColumns , xlFixedWidth, , , , , , , , , Array(Array(0, 9), Array(1, 4))
    Rng.NumberFormat = "dd/mm/yyyy"
End Sub

It takes it ~0.85 sec to process a 100,000-row dataset in Excel 2010.
Kenneth's sub from Post # 3 was consistently at ~1.1 sec.
Rick's sub from Post # 6 was consistently at ~1.35 sec.

Just in case, here is my sub for creating a 100,000-row dataset:
Code:
Sub Fill_100K_Rows()
    Dim i As Long
    Application.ScreenUpdating = False
    For i = 1 To 100000
        Range("A" & i) = 1 & _
            Format(Application.RandBetween(1, 28), "00") & _
            Format(Application.RandBetween(1, 12), "00") & _
            Format(Application.RandBetween(0, 99), "00")
    Next i
    Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top