VBA-Excel: Modified Consolidator – Merge or Combine Multiple Excel Files Into One Where Columns Are Not In Order

Download Link: MergeExcel

This is the extension of my earlier article “Consolidator“.

In this article we will modify it further. Suppose we have a scenario where we have multiple excel files with same columns but they are not in the same order. See the example below.

Modified Consolidator

How to Use it:

1. Down­load the MergerExcel.xlsm from the link pro­vided at the top and at the bot­tom of this article.
2. Place all the excel files, which you want to com­bine, into one folder (make sure all files are closed).
3. Open the MergerExcel.xlsm.
4. Provide the Folder path in the “Sheet1”.
5. Click the “Merge” Button.

Download Link: MergeExcel

Thanks Kumar for suggesting this article.

Complete Code:

Dim NoOfFiles As Double
    Dim counter As Integer
    Dim r_counter As Integer
    Dim s As String
    Dim listfiles As Files
    Dim newfile As Worksheet
    Dim mainworkbook As Workbook
    Dim combinedworksheet As Worksheet
    Dim tempworkbook As Workbook
   
    Dim rowpasted As Integer
    Dim delHeaderRow As Integer
    Dim Folderpath As Variant
    Dim headerset As Variant
    Dim Actualrowcount As Double
    Dim x As Long
    Dim Delete_Remove_Blank_Rows As String
    
Sub sumit()

    Dim rowCounter As Double
    
    Folderpath = ActiveWorkbook.Sheets("Sheet1").Range("B6").Value
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    NoOfFiles = fso.GetFolder(Folderpath).Files.Count
    Dim Files_Count_No_Of_Rows_In_Sheets(1000) As Double 'declare the array of the size of no of files in the folder
    
    
    Set listfiles = fso.GetFolder(Folderpath).Files
    rowCounter = 1
    
    Set mainworkbook = ActiveWorkbook
    Set combinedworksheet = mainworkbook.Sheets("Combine")
    mainworkbook.Sheets("Combine").UsedRange.Clear
    
    intFilesCounter = 1
    For Each fls In listfiles
        If intFilesCounter = 1 Then
            mainworkbook.Sheets("Combine").Activate
            mainworkbook.Sheets("Combine").Range("A" & rowCounter).Select
            Application.Workbooks.Open (Folderpath & "\" & fls.Name)
            Set tempworkbook = ActiveWorkbook
            Set newfile = ActiveSheet
            newfile.UsedRange.Copy
            mainworkbook.Sheets("Combine").Paste
            For x = mainworkbook.Sheets("Combine").Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
                If WorksheetFunction.CountA(mainworkbook.Sheets("Combine").Rows(x)) = 0 Then
                    mainworkbook.Sheets("Combine").Rows(x).Delete
                End If
            Next
            rowCounter = mainworkbook.Sheets("Combine").UsedRange.Rows.Count + 1
            combinedworksheet.UsedRange.ClearOutline
            tempworkbook.Close
        Else
            Application.Workbooks.Open (Folderpath & "\" & fls.Name)
            Set tempworkbook = ActiveWorkbook
            Set newfile = ActiveSheet
            
            intColumns = newfile.UsedRange.Columns.Count
            intRows = newfile.UsedRange.Rows.Count
            
            intR = rowCounter
            For j = 1 To intColumns
                strHeader = newfile.Cells(1, j)
                intIndex = findTheColumnNo(strHeader)
                For k = 2 To intRows
                    combinedworksheet.Cells(intR, intIndex).Value = newfile.Cells(k, j).Value
                    intR = intR + 1
                Next
                intR = rowCounter
            Next
            tempworkbook.Close
        End If
        intFilesCounter = intFilesCounter + 1
        rowCounter = mainworkbook.Sheets("Combine").UsedRange.Rows.Count + 1
    Next
End Sub


Function findTheColumnNo(strHeader)

    intcols = combinedworksheet.UsedRange.Columns.Count
    Dim intIndex
    For i = 1 To intcols
        If strHeader = combinedworksheet.Cells(1, i).Value Then
            intIndex = i
            Exit For
        End If
    Next
    findTheColumnNo = intIndex
End Function