Macro help - excel changes date format when importing multiple files

[Monty85]

Hi there.

Like many before me, I’m having issues with Excel converting dates to the US format when importing files to Excel via macro. I’ve found various solutions that claim to work but I am stuck and have been unable to find a solution for my application. I’m certainly no expert with macros and have only cobbled this together from finding other examples posted online, so may require some guidance in what I need to fix.

The purpose of the macro is to import multiple files (.dat files) into a single workbook and save each file as its own worksheet.

Sub CombineTextFiles()
'updateby Extendoffice 20151015
    Dim xFilesToOpen As Variant
    Dim I As Integer
    Dim xWb As Workbook
    Dim xTempWb As Workbook
    Dim xDelimiter As String
    Dim xScreen As Boolean
    On Error GoTo ErrHandler
    xScreen = Application.ScreenUpdating
    Application.ScreenUpdating = False
    xDelimiter = "|"
    xFilesToOpen = Application.GetOpenFilename("Text Files (*.DAT), *.DAT", , "Import Multiple Files", , True)
    If TypeName(xFilesToOpen) = "Boolean" Then
        MsgBox "No files were selected", , "Import Multiple Files"
        GoTo ExitHandler
    End If
    I = 1
    Set xTempWb = Workbooks.Open(xFilesToOpen(I))
    xTempWb.Sheets(1).Copy
    Set xWb = Application.ActiveWorkbook
    xTempWb.Close False
    xWb.Worksheets(I).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Tab:=False, Semicolon:=False, _
      Other:=False, OtherChar:="|"
    Do While I < UBound(xFilesToOpen)
        I = I + 1
        Set xTempWb = Workbooks.Open(xFilesToOpen(I))
        With xWb
            xTempWb.Sheets(1).Move after:=.Sheets(.Sheets.Count)
            .Worksheets(I).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, _
              ConsecutiveDelimiter:=False, _
              Tab:=False, Semicolon:=False, _
              Comma:=True, Space:=False, _
              Other:=False, OtherChar:=xDelimiter
        End With
    Loop
ExitHandler:
    Application.ScreenUpdating = xScreen
    Set xWb = Nothing
    Set xTempWb = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Description, , "Import Multiple Files"
    Resume ExitHandler
End Sub

 

[John_w]

Welcome to MrExcel forums.

Try changing both Workbooks.Open lines to:

    Set xTempWb = Workbooks.Open(xFilesToOpen(I), Local:=True)

 

[Monty85]

Welcome to MrExcel forums.

Try changing both Workbooks.Open lines to:

    Set xTempWb = Workbooks.Open(xFilesToOpen(I), Local:=True)

Thanks!

So I’ve changed the 2 instances of that line to include the “Local:=True” part but am still getting the same issue.

Sample of the code below (in case I missed something).

 Sub CombineTextFiles()
'updateby Extendoffice 20151015
    Dim xFilesToOpen As Variant
    Dim I As Integer
    Dim xWb As Workbook
    Dim xTempWb As Workbook
    Dim xDelimiter As String
    Dim xScreen As Boolean
    On Error GoTo ErrHandler
    xScreen = Application.ScreenUpdating
    Application.ScreenUpdating = False
    xDelimiter = "|"
    xFilesToOpen = Application.GetOpenFilename("Text Files (*.DAT), *.DAT", , "Import Multiple Files", , True)
    If TypeName(xFilesToOpen) = "Boolean" Then
        MsgBox "No files were selected", , "Import Multiple Files"
        GoTo ExitHandler
    End If
    I = 1
    Set xTempWb = Workbooks.Open(xFilesToOpen(I), Local:=True)
    xTempWb.Sheets(1).Copy
    Set xWb = Application.ActiveWorkbook
    xTempWb.Close False
    xWb.Worksheets(I).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Tab:=False, Semicolon:=False, _
      Other:=False, OtherChar:="|"
    Do While I < UBound(xFilesToOpen)
        I = I + 1
        Set xTempWb = Workbooks.Open(xFilesToOpen(I), Local:=True)
        With xWb
            xTempWb.Sheets(1).Move after:=.Sheets(.Sheets.Count)
            .Worksheets(I).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, _
              ConsecutiveDelimiter:=False, _
              Tab:=False, Semicolon:=False, _
              Comma:=True, Space:=False, _
              Other:=False, OtherChar:=xDelimiter
        End With
    Loop
ExitHandler:
    Application.ScreenUpdating = xScreen
    Set xWb = Nothing
    Set xTempWb = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Description, , "Import Multiple Files"
    Resume ExitHandler
End Sub

 

[John_w]

Scratch that, as I think Local:=True only works on Excel and csv files. You've applied my change correctly though.

As you're using the TextToColumns, does it work if you tell it to use DMY format for the date column? If it does, record a macro using the Text to Columns wizard and it will generate a FieldInfo:= argument which you can add to the TextToColumns statements in your code, something like this:

    xWb.Worksheets(I).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Tab:=False, Semicolon:=False, _
      Other:=False, OtherChar:="|"[COLOR=#ff0000][B], FieldInfo:=Array(Array(1, 4), Array(2, 1), Array(3, 1))[/B][/COLOR]

If that doesn't work, please post examples of your input data where the date is converted correctly and incorrectly.

 

[Monty85]

So the tricky part with that would be that each file i'm importing via the macro doesn't have the dates in the same column. So specifying a particular column as DMY isn't (i dont think) possible.

Recording the macro and opening 1 file gives me this code (but adding that to my original code didn't work either).

Sub Macro3()
'
' Macro3 Macro
'

'
    Workbooks.OpenText Filename:= _
        "J:\2019\TAP190416230808.DAT" _
        , Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
        , Comma:=True, Space:=False, Other:=False, OtherChar:="|", FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True
    Columns("G:G").ColumnWidth = 10.71
End Sub

I can't post the data i'm working on but i could possibly put together something as an example if we still can't find a solution (if there even is one)

 

[white84]

I have a similar issue where a macro file has converted all the "General" formatted cells to Date. Most fields have alpha text so no changes, but some cells had numeric years now show as "July-05". I have been going making these changes manually but I have over 200 tabs, and I believe the next time I run my macro the issue will occur again. Any ideas?

 

[Joe4]

I have a similar issue where a macro file has converted all the "General" formatted cells to Date. Most fields have alpha text so no changes, but some cells had numeric years now show as "July-05".

What kind of data is being imported, and what format SHOULD it be in?
Maybe a few examples here would be helpful.

 

[white84]

What kind of data is being imported, and what format SHOULD it be in?
Maybe a few examples here would be helpful.

I don't mean to take over this thread, but in my case I have already copied and pasted as values. I have 3 macros. To hide and unhide sheets, reorder the sheets, or to format labels in a chart. Could that be it?

Here is the format label code

Sub FormatLabels()Dim s As Series, y, dl As DataLabel, i%, r As Range
Set r = [j5]
Set s = ActiveSheet.ChartObjects("Chart737").Chart.SeriesCollection(1)
y = s.Values
For i = LBound(y) To UBound(y)
    Set dl = s.Points(i).DataLabel
    Select Case r
        Case Is = "Won"
            dl.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
            dl.Format.Fill.ForeColor.RGB = RGB(146, 208, 80)
        Case Is = "Lost"
            dl.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
            dl.Format.Fill.ForeColor.RGB = RGB(250, 5, 5)
    End Select
    Set r = r.Offset(1)
Next
End Sub

 

[Joe4]

Without seeing what the data you are working with looks like, and all of your VBA code, it is very difficult to tell.

I don't mean to take over this thread

Yes, typically, unless your question is specifically about something in the current thread, it is usually best to best your own question in a new thread. You can always add links to other threads, if you think they may be helpful.