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":
Notice that after running the macro that the date "01.12.2022" changes to "12.01.2022":
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