Search code examples
vbaexceltext-to-column

Excel text to columns formatting to date issue

Good morning,

I have a macro that imports all text files from a directory into the workbook. This has been working very well and has not had any formatting or related issues.

I have encountered text files that seem to autoformat and am having troubl.e trying to get this to work with text to columns.

Data in text file:

#
#
#
# CELL : RESULT
#
0:0
1:0
2:0
3:0
4:0
5:0
6:0
7:0
8:0
9:0
10:0
11:0
12:0
13:0
14:0
15:0
16:0
17:0
18:0
19:0
20:0
21:0
22:0
23:0
24:0
25:

After import:

# CELL : RESULT
#
0:00
1:00
2:00
3:00
4:00
5:00
6:00
7:00
8:00
9:00
10:00
11:00
12:00
13:00
14:00
15:00
16:00
17:00
18:00
19:00
20:00
21:00
22:00
23:00
24:00:00

After text to column:

#       
#       
#       
# CELL   RESULT 
#       
0:00    0   12:00 AM
0:00    0   12:00 AM
0:00    0   12:00 AM
0:00    0   12:00 AM
0:00    0   12:00 AM
0:00    0   12:00 AM
0:00    0   12:00 AM
0:00    0   12:00 AM
0:00    0   12:00 AM
0:00    0   12:00 AM
0:00    0   12:00 AM
0:00    0   12:00 AM
0:00    0   12:00 PM
0:00    0   12:00 PM
0:00    0   12:00 PM
0:00    0   12:00 PM
0:00    0   12:00 PM
0:00    0   12:00 PM
0:00    0   12:00 PM
0:00    0   12:00 PM
0:00    0   12:00 PM
0:00    0   12:00 PM
0:00    0   12:00 PM
0:00    0   12:00 PM
1/1/1900  12    0   12:00 AM

When copied and pasted, the data looks fine.

I have tried converted data to general or text but that turns the data into decimals. I have also tried to trim the last ":*" out but have failed at that too.

If anyone has any guidance on what is happening, I would be greatly appreciative. The code I am using to import the text files is:

Sub Import_Text_Files()

    Dim fPath   As String
    Dim fCSV    As String
    Dim wbCSV   As Workbook
    Dim wbMST   As Workbook

    Set wbMST = ThisWorkbook
    'this is to set the directory in which the text files are
    fPath = Sheets("Console").Cells(16, 12).Value

    'turn off screen updating for speed
    Application.ScreenUpdating = False

    'start the text file listing
    fCSV = Dir(fPath & "*.txt")
    On Error Resume Next
    Do While Len(fCSV)      0
        'open a CSV file
        Set wbCSV = Workbooks.Open(fPath & fCSV)
        'delete sheet if it exists
        wbMST.Sheets(ActiveSheet.Name).Delete
        'move new sheet into workbook
        ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count)
        'ready next CSV
        fCSV = Dir
    Loop

    Set wbCSV = Nothing

End Sub

I apologize I cannot post images on this account as I do not have the reputation and haven't used this site in years. I have them on my end, however.

Solution

  • Instead of Workbooks.Open you could be using Workbooks.OpenText

    If you do that, you can specify the colon as the delimiter and split it before Excel has a chance to change it to what it thinks you might prefer (times in this case).

    It is rarely a good idea to use Workbooks.Open on a text file.

    Check VBA Help for more information on `Workbooks.OpenText

    Example code:

    Workbooks.OpenText Filename:=fullPathofTextFile, _
    Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=False, Other:=True, OtherChar:=":", FieldInfo:= _
    Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

    You could also use Power Query (aka Get&Transform) to accomplish the same thing with a Data Connection that can be refreshed, if necessary.

    The ADO option mentioned in the comments is especially useful if the text file is UTF-8.