Change Text to Date with VBA TextToColumns-CodePudding

Edit: VBA code now is working. Was just and .currentregion that messed it up for me

I have an issue, that is hopefully just some silly mistake from myside. I have a dataset that I get at least once a day with the dates not recognised as date, but as normal text. I would like to have this column changed to date with a VBA macro. The code I have written now, just gives me an error message, and I can not figure out what is wrong.

This is how the file looks, I could not figure out how to attach the file...

And here is my code

Sub Test()

Dim rg As Range
Set rg = Range("B2:B4")
rg.TextToColumns Destination:=Range("B2:B5"), ConsecutiveDelimiter:=True, DataType:=xlDelimited, Space:=True, FieldInfo:=Array(Array(1, 5))

End Sub

Any suggestion what might be wrong with the code or how I can make it work? The date format is YMD when I do this in the Text to Columns in excel itself. This is a part of a bigger VBA, so it would be much easier to do it as a VBA than to do it manually every time I need it.

CodePudding user response：

In Excel I would use the following, assuming ERIKA's date is in B2:

=DATE(LEFT(B2,4),MID(B2,5,2),RIGHT(B2,2))

In VBA, in a function, I would use:

Function TextToDate(txt As String) As Date
TextToDate = DateSerial(Left(txt, 4), Mid(txt, 5, 2), Right(txt, 2))
End Function

CodePudding user response：

I suggest to load all data to an array and then run the "migration". Using an array to manipulate data is much faster then working on cells directly.

Alternatively you can use a formula as well.


Option Explicit

Public Sub migrateDate()
Dim ws As Worksheet: Set ws = ActiveSheet   'adjust to your needs
Dim rgDates As Range
Set rgDates = ws.Range("B2:B5")  'adjust to your needs, use explicit .Range referencing the worksheet you want to work on - not an implicit Range!!!

Dim arrDates As Variant
arrDates = rgDates.Value

Dim i As Long
Dim strDate As String, year As Long, month As Long, day As Long

For i = 1 To UBound(arrDates, 1)
    strDate = arrDates(i, 1)
    If LenB(strDate) > 0 Then
        If IsNumeric(strDate) And Len(strDate) = 8 Then
            year = Left(strDate, 4)
            month = Mid(strDate, 5, 2)
            day = Right(strDate, 2)
        End If
        arrDates(i, 1) = DateSerial(year, month, day)
    End If
Next

rgDates.Value = arrDates

End Sub