Merge files and keep source formatting.

[Dave_george]

The code helps me to merge files. Excel auto changes the formatting of dates after merging the files. I have to use text to columns to format the dates again. Is there a workaround to keep the original format? I am using excel 2016. The dates changes from DD/MM/YYYY to MM/DD/YYYY after the files get merged. Mostly the dates are in column AY. TIA

Private Sub CommandButton2_Click()

    Dim SummarySheet As Worksheet
    Dim NewWbk As Workbook
    Dim folderPath As String
    Dim SelectedFiles() As Variant
    Dim NRow As Long
    Dim filename As String
    Dim NFile As Long
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range
    Dim LastColumn As Long
    
    
    
    Set NewWbk = Workbooks.Add
    Set SummarySheet = NewWbk.Sheets(1)
    
 

    On Error GoTo Koniec
   
    SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Workbooks (*.xls; *.xlsm; *.csv; *.xlsx),*.xls;*.xslm;*.csv;*.xlsx", MultiSelect:=True)
    
    NRow = 1
    
    ' Loop through the list of returned file names
    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        ' Set FileName to be the current workbook file name to open.
        filename = SelectedFiles(NFile)
        
        Set WorkBk = Workbooks.Open(filename)
        
        
        FindRange = WorkBk.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row

   
    With WorkBk.Worksheets(1).UsedRange
        LastColumn = .Columns(.Columns.Count).Column
    End With

    
        Set SourceRange = WorkBk.Worksheets(1).Range(Cells(1, 1), Cells(FindRange, LastColumn))
        
        ' Set the destination range to start at column B and be the same size as the source range.
        Set DestRange = SummarySheet.Range("A" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
           
       
        SourceRange.Copy DestRange
        
        
        NRow = NRow + DestRange.Rows.Count
        
      
        WorkBk.Close savechanges:=False
    Next NFile
    
   
    SummarySheet.Columns.AutoFit
    
    
    Dim CellA1 As String, CellA2 As String
    
    CellA1 = SummarySheet.Range("A1").Value
    CellA2 = SummarySheet.Range("A2").Value
    
    last = Cells(Rows.Count, "A").End(xlUp).Row
    
    For i = last To 2 Step -1
        If (Cells(i, "A").Value) = CellA1 Or (Cells(i, "A").Value) = CellA2 Then
            Cells(i, "A").EntireRow.Delete
        End If
    Next i

MsgBox "Done !!!", vbInformation

Exit Sub

Koniec:

    NewWbk.Close savechanges:=False
    
    MsgBox "No File Specified.", vbExclamation, "ERROR"

End Sub

 

[Alex Blakenburg]

That's more likely to be a data issue, the code looks ok to me.
Are you intending to do a staight copy paste ? Typically when you copy data in from another workbook you do a paste values, as you did in one of your previous posts linked below.
If making that change doesn't resolve it pick one of the dates that looks wrong click in the box in the source file and show us an image that includes.
The row and column references, some of the rows in the AY column including the selected cell and the formula bar.


Your previous post:

paste special with formatting and without formula

Hello, I have a Macro below that let's me grab data from other workbook. I need it to copy data without formula but needs to include the formatting. Sub Copy_from_workbook() Workbooks.Open "C:\Users\grg01\Desktop\perf.xlsx" Workbooks("perf").Worksheets("Sheet4").Range("A1:F6").Copy _...

www.mrexcel.com

 

[Dave_george]

Yes I am trying to straight copy paste. The original data(see screenshot 1) does have proper dates however it changes to after merging(See screenshot 3). I even tried doing text to columns after the macro merges the files and it just wouldn't work. My data spans to last column DC. Screenshot 2 shows my raw data, Column AY.

 

[Dave_george]

Here is a screenshot of cell selected in AY. There are no formulas in the files getting merged.

 

[Dave_george]

I Finally sound the solution. The code below formats it perfectly for me. I was using array (1,3) which was incorrect. Even if I recorded the macro it would give me array (1,3). I just needed to use it like below.

       Columns("AY:AY").Select
    Selection.TextToColumns Destination:=Range("AY1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 4), Array(2, 9)), TrailingMinusNumbers:=True

 

[Alex Blakenburg]

Glad you found something that works for you.
Just curious though are your original files csv and if you open them in notepad are the dates in US format mm/dd/yyyy ?

Instead of doing text to columns conversion just adding what I have in red below may fix the issue.

Set WorkBk = Workbooks.Open(filename), local:=False

 

[Dave_george]

Glad you found something that works for you.
Just curious though are your original files csv and if you open them in notepad are the dates in US format mm/dd/yyyy ?

Instead of doing text to columns conversion just adding what I have in red below may fix the issue.

Set WorkBk = Workbooks.Open(filename), local:=False

Yes they're .csv. Opened them in notepad and they're dd/mm/yyyy format

 

[Alex Blakenburg]

Does adding ", local:=True" without the quotes to the Workbooks.Open line make any difference ?

 

[Dave_george]

Glad you found something that works for you.
Just curious though are your original files csv and if you open them in notepad are the dates in US format mm/dd/yyyy ?

Instead of doing text to columns conversion just adding what I have in red below may fix the issue.

Set WorkBk = Workbooks.Open(filename), local:=False

Sorry for the delay. I tired this but game me syntax error. I used it like this and it worked fine. Set WorkBk = Workbooks.Open(filename:=filename, Local:=True)

Thank you. Now I don't need to do text to columns.

 

[Alex Blakenburg]

Oops, sorry I did it on the fly instead of in the vba editor. Glad you managed to correct it and that it worked for you.