Rearranging Columns in Multiple Excel Files

Question

I have more than 100 excel files in .xlsx extension, Columns in all the files are not in order, i would like to re-arrange the Column order as per my Template and i would like to append the data from all files into one Output file.

i have tried the solution in this link Rearranging Columns in Multiple Excel Files using VBA and it did not work.

below are the sample files Headings for reference.

File1

Heading1,Heading2,Heading3

File2

Heading2,Heading1,Heading5,Heading7

Template File

Heading1,Heading2,Heading3,Heading4,Heading5,Heading6,Heading7

Expected Output File

FileName,Heading1,Heading2,Heading3,Heading4,Heading5,Heading6,Heading7

Answer 1

Try the below.

Sub Order_Columns()
    Dim template_headers As Variant, header As Variant, current_header As Variant, cl As Range, col As Integer

    template_headers = Array("Heading1", "Heading2", "Heading3", "Heading4", "Heading5")

    For header = LBound(template_headers) To UBound(template_headers)
        current_header = template_headers(header)

        col = col + 1
        Set cl = ActiveSheet.Rows(1).Find(What:=current_header, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

        If Not cl Is Nothing Then
            If Not cl.Column = col Then
                Columns(cl.Column).Cut
                Columns(col).Insert Shift:=xlToRight
            End If
        End If
    Next header
End Sub

• Specify your desired header order in the array
• Note that headers are case-sensitive so maybe use LCase()?

I will leave with you to add code to loop over your 100+ folders to do this and then place that data in your master sheet!

Answer 2

Assuming that in every file you're working on sheet(1) this would do the job:

Option Explicit
Sub ColumnMover()

    Dim i As Integer, j As Integer, k As Integer, m As Integer, n As Integer
    Dim mDirs As String
    Dim path As String
    Dim OutFile As Variant, SrcFile As Variant
    Dim MyObj As Object, MySource As Object, file As Variant

    OutFile = ActiveWorkbook.Name
        mDirs = "c:\" 'your path here with \ in the end
        file = Dir(mDirs)
        While (file <> "")
            path = mDirs + file
            Workbooks.Open (path)
            SrcFile = ActiveWorkbook.Name

            n = 2
            While Workbooks(OutFile).Sheets(1).Cells(n, 1).Value <> ""
                n = n + 1
            Wend

            i = 2
            While (Workbooks(OutFile).Sheets(1).Cells(1, i).Value <> "")
                k = n
                j = 1
                While Workbooks(SrcFile).Sheets(1).Cells(1, j).Value <> Workbooks(OutFile).Sheets(1).Cells(1, i).Value And _
                      Workbooks(SrcFile).Sheets(1).Cells(1, j).Value <> ""

                    j = j + 1
                Wend

                If Workbooks(SrcFile).Sheets(1).Cells(1, j).Value = Workbooks(OutFile).Sheets(1).Cells(1, i).Value Then

                    m = 2
                    While Workbooks(SrcFile).Sheets(1).Cells(m, j).Value <> ""

                        Workbooks(OutFile).Sheets(1).Cells(k, 1).Value = path
                        Workbooks(OutFile).Sheets(1).Cells(k, i).Value = Workbooks(SrcFile).Sheets(1).Cells(m, j).Value

                        k = k + 1
                        m = m + 1
                    Wend
                End If

                i = i + 1
            Wend

            Workbooks(file).Close (False)
            file = Dir
        Wend
End Sub

EDIT:

Some explanation:

here the template file and the output file are the same. So first you have to have an xlsm with the structure on sheet(1):

FileName,Heading1,Heading2,Heading3,Heading4,Heading5,Heading6,Heading7

then enter the given code into this file, and run it when the output file is the active sheet.