Macro help - excel changes date format when importing multiple files

M

Monty85

New Member
Joined
May 6, 2019
Messages
43
Office Version
  1. 365
Platform
  1. Windows
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.

Code: 
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
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Sort by date Sort by votes
Welcome to MrExcel forums.

Try changing both Workbooks.Open lines to:
Code: 
    Set xTempWb = Workbooks.Open(xFilesToOpen(I), Local:=True)
 
Upvote 0
John_w said:
Welcome to MrExcel forums.

Try changing both Workbooks.Open lines to:
Code: 
    Set xTempWb = Workbooks.Open(xFilesToOpen(I), Local:=True)
Click to expand...

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).

Code: 
 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
 
Upvote 0
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:

Code: 
    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.
 
Last edited:
Upvote 0
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).

Code: 
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) :)
 
Upvote 0
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?
 
Upvote 0
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".
Click to expand...
What kind of data is being imported, and what format SHOULD it be in?
Maybe a few examples here would be helpful.
 
Last edited:
Upvote 0
Joe4 said:
What kind of data is being imported, and what format SHOULD it be in?
Maybe a few examples here would be helpful.
Click to expand...

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
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
 
Upvote 0
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
Click to expand...
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Automatically import .txt files into separate sheets in Excel
Replies
1
Views
159
John_w
J
L
  • Solved
Import multiple text files to separated sheets onto current workbook
Replies
6
Views
752
llbac
L
G
  • Solved
Change Macro to import files from hyperlinks
2
Replies
12
Views
373
GarnesGambit
G
Q
  • Question
How to remove 400 error from clear even rows/text to columns macro?
Replies
1
Views
141
Joe4
Joe4
C
  • Question
Macro Help: Adding Search Box to a Macro
Replies
1
Views
301
Chrisa1956
C

Forum statistics

Threads
1,214,376
Messages
6,119,181
Members
448,871
Latest member
hengshankouniuniu

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top