none
Merging data from multiples excel files into a single worksheet in the order of date modified. RRS feed

  • Question

  • I have a large number of Excel files which are downloaded from net. They are downloaded in sequence. So I want to merge them into a single sheet in the same order of files I down loaded. I tried some VBA scripts but I am not able to sort the files in the order of date last modified. Would be highly obliged if you can give me script which can run on Microsoft Surface 4 pro with Windows 10 and office 365.

    Regards,

    Monday, October 31, 2016 9:18 AM

Answers

  • Hi Celeste, Good morning.

    Thanks for the effort and your time. It is very nice of you to have spent your time for me.

    I tried this code. It created a new sheet but no output. Probably it was not selecting and file in the sorted list.

    There was no error msg also.

    Meanwhile I tried another code I found on the web from the site "

    Ron de Bruin Excel Automation"

    That code prompts for selection of excel files from the pop-up file selection window. There I can sort them on Date modified column and then select the files in that order. And the data is copied from the files in the order the files are selected. Which solved my problem.

    Thanks once again.

    • Proposed as answer by Chenchen LiModerator Thursday, November 3, 2016 1:20 AM
    • Marked as answer by KVNRAO Thursday, November 3, 2016 3:52 AM
    Thursday, November 3, 2016 12:58 AM

All replies

  • Hi KVNRAO,

    I'd like to know, to ask some questions.

    1. Have you summarized/merged multiple Excel files into a single worksheet(another file)?
    2. What do you mean by "sort the files in the order of date last modifies"?
       Does a target file(worksheet) contain a column for time-stamp of source files?

    Would you share a sample file via cloud storage such as OneDrive or DropBox?

    Regards,
    Ashidachi

    Monday, October 31, 2016 10:37 AM
  • Hi,

    Sorry for the late response. I went off early yesterday.

    Q1: I tried to merge data from multiple workbooks into a single sheet. But my problem is to merge them in a proper sequence.

    The .xls files I have are sequentially downloaded from internet and I want to merge them in the same sequence.

    for example the files are like:

    Name                             Date modified                 Type                                   Size

    Scoreboard1.xls            10/27/2016 4:50 PM    Microsoft Excel 97...               25 KB

    Scoreboard2.xls            10/27/2016 4:51 PM    Microsoft Excel 97...               25 KB

    .

    .

    .

    ------

    I used the code below and the result was that data from the 8th file was written first and then the data is in a random order. So I want to use the sort option on ' Date Last Modified' Property of the file to set the sequence right which I am not able to do. 

    Hope I am clear.

    MERGING all workbooks in a directory   

    Sub MergeAllWorkbooks()

        Dim MyPath As String, FilesInPath As String

        Dim MyFiles() As String

        Dim SourceRcount As Long, FNum As Long

        Dim mybook As Workbook, BaseWks As Worksheet

        Dim sourceRange As Range, destrange As Range

        Dim rnum As Long, CalcMode As Long

        ' Change this to the path\folder location of your files.

        MyPath = "H:\CAPMAR\TEST"

        ' Add a slash at the end of the path if needed.

        If Right(MyPath, 1) <> "\" Then

            MyPath = MyPath & "\"

        End If

        ' If there are no Excel files in the folder, exit.

        FilesInPath = Dir(MyPath & "*.xl*")

        If FilesInPath = "" Then

            MsgBox "No files found"

            Exit Sub

        End If

        ' Fill the myFiles array with the list of Excel files

        ' in the search folder.

        FNum = 0

        Do While FilesInPath <> ""

            FNum = FNum + 1

            ReDim Preserve MyFiles(1 To FNum)

            MyFiles(FNum) = FilesInPath

            FilesInPath = Dir()

        Loop

        ' Set various application properties.

        With Application

            CalcMode = .Calculation

            .Calculation = xlCalculationManual

            .ScreenUpdating = False

            .EnableEvents = False

        End With

        ' Add a new workbook with one sheet.

        Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

        rnum = 1

        ' Loop through all files in the myFiles array.

        If FNum > 0 Then

            For FNum = LBound(MyFiles) To UBound(MyFiles)

                Set mybook = Nothing

                On Error Resume Next

                Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))

                On Error GoTo 0

                If Not mybook Is Nothing Then

                    On Error Resume Next

                    ' Change this range to fit your own needs.

                    With mybook.Worksheets(1)

                        Set sourceRange = .Range("A1:AI56")

                    End With

                    If Err.Number > 0 Then

                        Err.Clear

                        Set sourceRange = Nothing

                    Else

                        ' If source range uses all columns then

                        ' skip this file.

                        If sourceRange.Columns.Count >= BaseWks.Columns.Count Then

                            Set sourceRange = Nothing

                        End If

                    End If

                    On Error GoTo 0

                    If Not sourceRange Is Nothing Then

                        SourceRcount = sourceRange.Rows.Count

                        If rnum + SourceRcount >= BaseWks.Rows.Count Then

                            MsgBox "There are not enough rows in the target worksheet."

                            BaseWks.Columns.AutoFit

                            mybook.Close savechanges:=False

                            GoTo ExitTheSub

                        Else

                            ' Copy the file name in column A.

                            With sourceRange

                                BaseWks.Cells(rnum, "A"). _

                                        Resize(.Rows.Count).Value = MyFiles(FNum)

                            End With

                            ' Set the destination range.

                            Set destrange = BaseWks.Range("B" & rnum)

                            ' Copy the values from the source range

                            ' to the destination range.

                            With sourceRange

                                Set destrange = destrange. _

                                                Resize(.Rows.Count, .Columns.Count)

                            End With

                            destrange.Value = sourceRange.Value

                            rnum = rnum + SourceRcount

                        End If

                    End If

                    mybook.Close savechanges:=False

                End If

            Next FNum

            BaseWks.Columns.AutoFit

        End If

    ExitTheSub:

        ' Restore the application properties.

        With Application

            .ScreenUpdating = True

            .EnableEvents = True

            .Calculation = CalcMode

        End With

    End Sub

    Tuesday, November 1, 2016 2:13 AM
  • Hi,

    I think it is improper to use 'Date Last Modified' Property. If you open one of files by accident, the array is wrong again.

    If the file names are sequential like Scoreboard #.xls, you could sort the array MyFiles() by names.

    You could use the BubbleSort shared by Hans to sort the file array, please see Sorting An Array in VBA (without excel function) This method could apply to string.

    Sub sort()
    Dim a(3) As String
    a(1) = "test1.xls"
    a(2) = "test3.xls"
    a(3) = "test2.xls"
    Call BubbleSort(a)
    Debug.Print a(2)
    End Sub
    
    Sub BubbleSort(arr)
      Dim strTemp As String
      Dim i As Long
      Dim j As Long
      Dim lngMin As Long
      Dim lngMax As Long
      lngMin = LBound(arr)
      lngMax = UBound(arr)
      For i = lngMin To lngMax - 1
        For j = i + 1 To lngMax
          If arr(i) > arr(j) Then
            strTemp = arr(i)
            arr(i) = arr(j)
            arr(j) = strTemp
          End If
        Next j
      Next i
    End Sub

    Regards,

    Celeste



    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    • Proposed as answer by Vivek Vicky Wednesday, November 2, 2016 11:51 AM
    Tuesday, November 1, 2016 1:33 PM
    Moderator
  • Hi Celeste,

    Thanks for the suggestion. But my problem is the number of files is so large that it is difficult for me to rename them in a sequence. They are about 500 files. While down loading the system automatically allocates file numbers which are having a funny convention. So can not do a sort on file names.

    Regards

    Wednesday, November 2, 2016 2:00 AM
  • Hi,

    In my opinion, you have got the file name array (myFiles array). The reason that the data in a random order is that, in the file array, the names are like myFiles(1)="test2.xls" myFiles(2)="test1.xls".

    So adding Call BubbleSort(myFiles) after the DO..LOOP could help the array in sequential order and it would not change the file name.

    Regards,

    Celeste


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Wednesday, November 2, 2016 2:30 AM
    Moderator
  • I am not good in writing the scripts. I just take the code from net and adopt to my situation by adding the path and changing the ranges and names. Can you please edit the above script to suite my needs. If you can find a way to sort the files in the order they are downloaded - will be of great help. When I open the directory, I just click on the 'date last modified property' and the files get sorted on that. Can we do that through the macro?

    Thanks in anticipation.

    Wednesday, November 2, 2016 4:01 AM
  • Hi,

    You could try the code below. It sorts the file array by DateLastModified.

    I suppose there is no "@" in your file name.

    'MERGING all workbooks in a directory
    Sub MergeAllWorkbooks()
        Dim MyPath As String, FilesInPath As String
        Dim MyFiles() As String
        Dim SourceRcount As Long, FNum As Long
        Dim mybook As Workbook, BaseWks As Worksheet
        Dim sourceRange As Range, destrange As Range
        Dim rnum As Long, CalcMode As Long
        ' Change this to the path\folder location of your files.
        MyPath = "D:\test"
        ' Add a slash at the end of the path if needed.
        If Right(MyPath, 1) <> "\" Then
            MyPath = MyPath & "\"
        End If
        ' If there are no Excel files in the folder, exit.
        FilesInPath = Dir(MyPath & "*.xl*")
        Debug.Print MyPath
        If FilesInPath = "" Then
            MsgBox "No files found"
            Exit Sub
        End If
        ' Fill the myFiles array with the list of Excel files
        ' in the search folder.
        FNum = 0
        Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        Do While FilesInPath <> ""
            FNum = FNum + 1
            ReDim Preserve MyFiles(1 To FNum)
            MyFiles(FNum) = FilesInPath & "@" & fso.GetFile(MyPath & FilesInPath).DateLastModified
            FilesInPath = Dir()
        Loop
        Call BubbleSort(MyFiles)
        ' Set various application properties.
        With Application
            CalcMode = .Calculation
            .Calculation = xlCalculationManual
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        ' Add a new workbook with one sheet.
        Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
        rnum = 1
        ' Loop through all files in the myFiles array.
        If FNum > 0 Then
            For FNum = LBound(MyFiles) To UBound(MyFiles)
                Set mybook = Nothing
                On Error Resume Next
                Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
                On Error GoTo 0
                If Not mybook Is Nothing Then
                    On Error Resume Next
                    ' Change this range to fit your own needs.
                    With mybook.Worksheets(1)
                        Set sourceRange = .Range("A1:AI56")
                    End With
                    If Err.Number > 0 Then
                        Err.Clear
                        Set sourceRange = Nothing
                    Else
                        ' If source range uses all columns then
                        ' skip this file.
                        If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
                            Set sourceRange = Nothing
                        End If
                    End If
                    On Error GoTo 0
                    If Not sourceRange Is Nothing Then
                        SourceRcount = sourceRange.Rows.Count
                        If rnum + SourceRcount >= BaseWks.Rows.Count Then
                            MsgBox "There are not enough rows in the target worksheet."
                            BaseWks.Columns.AutoFit
                            mybook.Close savechanges:=False
                            GoTo ExitTheSub
                        Else
                            ' Copy the file name in column A.
                            With sourceRange
                                BaseWks.Cells(rnum, "A"). _
                                        Resize(.Rows.Count).Value = MyFiles(FNum)
                            End With
                            ' Set the destination range.
                            Set destrange = BaseWks.Range("B" & rnum)
                            ' Copy the values from the source range
                            ' to the destination range.
                            With sourceRange
                                Set destrange = destrange. _
                                                Resize(.Rows.Count, .Columns.Count)
                            End With
                            destrange.Value = sourceRange.Value
                            rnum = rnum + SourceRcount
                        End If
                    End If
                    mybook.Close savechanges:=False
                End If
            Next FNum
            BaseWks.Columns.AutoFit
        End If
    ExitTheSub:
        ' Restore the application properties.
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
            .Calculation = CalcMode
        End With
    End Sub
    
    Sub BubbleSort(arr)
      Dim strTemp As String
      Dim i As Long
      Dim j As Long
      Dim lngMin As Long
      Dim lngMax As Long
      lngMin = LBound(arr)
      lngMax = UBound(arr)
      For i = lngMin To lngMax - 1
        For j = i + 1 To lngMax
      If CDate(Split(arr(i), "@")(1)) > CDate(Split(arr(j), "@")(1)) Then
            strTemp = arr(i)
            arr(i) = arr(j)
            arr(j) = strTemp
          End If
        Next j
      Next i
    End Sub
    

    >>When I open the directory, I just click on the 'date last modified property' and the files get sorted on that. Can we do that through the macro?

    It is impossible to do that in the macro by using Office object model.

    Regards,

    Celeste


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Wednesday, November 2, 2016 10:05 AM
    Moderator
  • Hi Celeste, Good morning.

    Thanks for the effort and your time. It is very nice of you to have spent your time for me.

    I tried this code. It created a new sheet but no output. Probably it was not selecting and file in the sorted list.

    There was no error msg also.

    Meanwhile I tried another code I found on the web from the site "

    Ron de Bruin Excel Automation"

    That code prompts for selection of excel files from the pop-up file selection window. There I can sort them on Date modified column and then select the files in that order. And the data is copied from the files in the order the files are selected. Which solved my problem.

    Thanks once again.

    • Proposed as answer by Chenchen LiModerator Thursday, November 3, 2016 1:20 AM
    • Marked as answer by KVNRAO Thursday, November 3, 2016 3:52 AM
    Thursday, November 3, 2016 12:58 AM
  • Hi,

    I am glad that you have found your desired solution and thanks for sharing.

    You could mark your reply as answer to close this thread and others could see the solution if they have same issue.

    If you have any other issues, please feel free to post threads.

    Regards,

    Celeste


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Thursday, November 3, 2016 1:20 AM
    Moderator