Home > Net >  TextToColumns for Date swapping Day and Month (when run twice)
TextToColumns for Date swapping Day and Month (when run twice)

Time:01-04

I have several data sources that are linked. I have a macro that runs a TextToColumns function, however, if TextToColumns is run again, it swaps the day and month. If I run it an additional time is swaps the day and month again back to the original position (it does not just change the format, it actually changes what is recognised as each in further processes).

As per TinMan's request, here is a test sub and convert function, as well as a screenshot of some sample data, which can be used to replicate the issue:

Sub test()
    Dim T_Test As ListObject
    Set T_Test = ThisWorkbook.Worksheets(1).ListObjects("T_Test")
    
    Call Convert_TextToColumns(T_Test, "Date", "DD.MM.YYYY")
End Sub

Sub Convert_TextToColumns(ByRef tbl As ListObject, headerName As String, nrFormat As String)
    Dim rng As Range
    Set rng = tbl.ListColumns(headerName).Range
    rng.NumberFormat = nrFormat
    rng.TextToColumns Destination:=rng, DataType:=xlDelimited, Other:=False, FieldInfo:=Array(1, xlDMYFormat)
End Sub

If you would like to replicate, please insert a table with data in image and create a table and name the table "T_Test":

enter image description here

Notice that after running the macro that the date "01.12.2022" changes to "12.01.2022": enter image description here

Running it again changes it back to the original "12.01.2022" again.

How could I prevent this?

I have tried using a function to remove the leading apostrophe instead of using TextToColumns, however my date doesn't convert to a "full date", where its filtered members group by year, month, day in the filters, and doesn't change any functionality from having the leading apostrophe:

Sub Convert_TextToDate(ByRef tbl As ListObject, headerName As String, nrFormat As String) ' format As String, str As String)
    ' Only convert if not already in date format.
    Dim rng As Range
    Set rng = tbl.ListColumns(headerName).DataBodyRange
    rng.Replace What:="'", replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True
    
    Dim cell As Variant
    Dim temp As Variant
    For Each cell In rng
        cell.Value = cell.Value ' tried this (doesn't work)
        cell.Value = Replace(cell.Value, "'", "") ' tried this (doesn't work)
    Next cell
End Sub

Is it possible to see if TextToColumns has already been executed on a column, i.e. that it has a "full date" format, which could be the condition for not running the function again?

Any assistance or other recommendations would be highly appreciated as I have been struggling with this for too long and gives many headaches in our processes.

Thank you in advance.

CodePudding user response:

You can use

Sub test()
    Dim T_Test As ListObject
    Set T_Test = ThisWorkbook.Worksheets(1).ListObjects("T_Test")
    
    Call Convert_TextToColumns(T_Test, "Date", "DD.MM.YYYY")
End Sub

Sub Convert_TextToColumns(ByRef tbl As ListObject, headerName As String, nrFormat As String)
    Dim rng As Range
    Set rng = tbl.ListColumns(headerName).Range
    If Application.WorksheetFunction.IsText(rng.Cells(2, 1)) = True Then
        rng.NumberFormat = nrFormat
        rng.TextToColumns Destination:=rng, DataType:=xlDelimited, Other:=False, FieldInfo:=Array(1, xlDMYFormat)
    End If
    
End Sub
  • Related