Rearranging Columns in Multiple Excel Files - vba

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.