Compare Column Order and Column Heads in multiple Files in a folder against a Template Worksheet/Workbook

[ragav_in]

Dear Friends and Forum users,

I am currently working on a activity that needs to be open multiple files within a folder and, check the Column order (Columns A to Column D) in first worksheet of each workbook against a pre-defined Column order (Column A to Column D) in a workbook called Template (and this is where the Macro is written and to be executed). I did some research on this and got this code which currently compares 2 worksheets in a particular workbook for the Column order and generates a Msgbox if the order does not match.

Source: Check order of columns
Macro to compare Column Order

Sub CompareFields()
    Dim templateColumns(), sourceColumns(), col As Integer

    templateColumns = Worksheets(1).Range("A1:D1").Value
    sourceColumns = Worksheets(2).Range("A1:D1").Value

    For col = 1 To UBound(templateColumns, 2)
        If templateColumns(1, col) <> sourceColumns(1, col) Then
            MsgBox "Source data not in the correct order"
            Exit For
        End If
    Next col
End Sub

I would want to know how to use this code to perform my activity of looping through multiple files in folder and perform this checking of order of columns. If it finds workbook that does not match the column order as mentioned in the Template, then, it should write that workbook name to a cell in another worksheet, so that at end of the macro execution, the column will have the list of workbooks from that folder that do not match the Columns order as mentioned in the Template worksheet.

I know this is a big ask, but I feel that this forum would provide me support in getting the resolution for the same. I thank everyone who puts their time and effort to go through this post and provide any suggestions that could help in accomplishing the task.

Many thanks in advance for all your support till date.

Thanks and grateful,
ragav_in

 

[mumps]

Make sure that the template workbook has a sheet named "Results". Change the sheet names (in red) and the folder path (in blue) to suit your needs.

Sub CompareColumns()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, Arr1 As Variant, Arr2 As Variant, val1 As String, val2 As String
    Set desWS = ThisWorkbook.Sheets("Results")
    Arr1 = ThisWorkbook.Sheets("Sheet1").Range("A1:D1").Value
    val1 = Arr1(1, 1) & "|" & Arr1(1, 2) & "|" & Arr1(1, 3) & "|" & Arr1(1, 4)
    Const strPath As String = "C:\Test\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB
            Arr2 = .Sheets("Sheet1").Range("A1:D1").Value
            val2 = Arr2(1, 1) & "|" & Arr2(1, 2) & "|" & Arr2(1, 3) & "|" & Arr2(1, 4)
            If val2 <> val1 Then
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1) = srcWB.Name
            End If
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[ragav_in]

Make sure that the template workbook has a sheet named "Results". Change the sheet names (in red) and the folder path (in blue) to suit your needs.

Sub CompareColumns()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, Arr1 As Variant, Arr2 As Variant, val1 As String, val2 As String
    Set desWS = ThisWorkbook.Sheets("Results")
    Arr1 = ThisWorkbook.Sheets("Sheet1").Range("A1:D1").Value
    val1 = Arr1(1, 1) & "|" & Arr1(1, 2) & "|" & Arr1(1, 3) & "|" & Arr1(1, 4)
    Const strPath As String = "C:\Test\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB
            Arr2 = .Sheets("Sheet1").Range("A1:D1").Value
            val2 = Arr2(1, 1) & "|" & Arr2(1, 2) & "|" & Arr2(1, 3) & "|" & Arr2(1, 4)
            If val2 <> val1 Then
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1) = srcWB.Name
            End If
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
[/CODE

Make sure that the template workbook has a sheet named "Results". Change the sheet names (in red) and the folder path (in blue) to suit your needs.

Sub CompareColumns()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, Arr1 As Variant, Arr2 As Variant, val1 As String, val2 As String
    Set desWS = ThisWorkbook.Sheets("Results")
    Arr1 = ThisWorkbook.Sheets("Sheet1").Range("A1:D1").Value
    val1 = Arr1(1, 1) & "|" & Arr1(1, 2) & "|" & Arr1(1, 3) & "|" & Arr1(1, 4)
    Const strPath As String = "C:\Test\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB
            Arr2 = .Sheets("Sheet1").Range("A1:D1").Value
            val2 = Arr2(1, 1) & "|" & Arr2(1, 2) & "|" & Arr2(1, 3) & "|" & Arr2(1, 4)
            If val2 <> val1 Then
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1) = srcWB.Name
            End If
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Dear mumps, firstly thanks a lot for your time and effort to help me out. But when I run this code, I get the "Run-time error '9': Subscript out of range" error message, and when I click debug, it takes to me this line of code

Arr2 = .Sheets("Sheet1").Range("A1:D1").Value

Is it looking for a sheet named "Sheet1" or the first worksheet in each book?
As mentioned by you, I have a sheet named Results in which this code is executed, and have a couple of other files with different column order. Please note that I updated the filepath to suit my requirements in my code. Can you please help me with why am I getting the error?

Also, I would request you kindly let me know how to handle the below scenarios

1. If I have to have the path Dynamic, can I get it (strPath) from a cell value in another sheet in the same workbook where this code is executed?
2. Should Results be the first worksheet in which the code is executed?
3. Please note that the Sheet Names in each of the workbooks in the folder will be different, and cannot be hard coded. What do I need to do for the code to look for the 1st worksheet in each and every workbook and perform the comparison? Is your code already performing the same?
4. If I have to extend my range from A:D to A:J, then should I append the below lines of code to increase the Array from 4 to 10 (e.g. until & Arr1(1, 10)?

val1 = Arr1(1, 1) & "|" & Arr1(1, 2) & "|" & Arr1(1, 3) & "|" & Arr1(1, 4)
val2 = Arr2(1, 1) & "|" & Arr2(1, 2) & "|" & Arr2(1, 3) & "|" & Arr2(1, 4)

I have attached a screenshot of the code that I am using just for reference. I would be very grateful to you if you can help me with the above clarifications so that I can get the resolution. Once again, I am very thankful to you to have provided me the support.

Thanks and grateful,
ragav_in

 

[mumps]

I have added some explanatory comments.

Sub CompareColumns()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet, srcWB As Workbook
    Set srcWS = ThisWorkbook.Sheets(1) 'this is the first sheet in Template which contains the columns to compare
    Set desWS = ThisWorkbook.Sheets("Results") 'make sure the Results sheet is not the first or second sheet
    Const strPath As String = ThisWorkbook.Sheets(2).Range("A1") 'this is the second sheet in Template which contains the full file path including the backslash ( \ ) at the end
                    'change the '2' and 'A1" to suit your needs
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB
            'change Range("A1:J1") to suit your needs
            If Join(Application.Transpose(Application.Transpose(.Sheets(1).Range("A1:J1").Value)), "|") <> _
                Join(Application.Transpose(Application.Transpose(srcWS.Range("A1:J1").Value)), "|") Then
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1) = srcWB.Name
            End If
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[ragav_in]

I have added some explanatory comments.

Sub CompareColumns()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet, srcWB As Workbook
    Set srcWS = ThisWorkbook.Sheets(1) 'this is the first sheet in Template which contains the columns to compare
    Set desWS = ThisWorkbook.Sheets("Results") 'make sure the Results sheet is not the first or second sheet
    Const strPath As String = ThisWorkbook.Sheets(2).Range("A1") 'this is the second sheet in Template which contains the full file path including the backslash ( \ ) at the end
                    'change the '2' and 'A1" to suit your needs
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB
            'change Range("A1:J1") to suit your needs
            If Join(Application.Transpose(Application.Transpose(.Sheets(1).Range("A1:J1").Value)), "|") <> _
                Join(Application.Transpose(Application.Transpose(srcWS.Range("A1:J1").Value)), "|") Then
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1) = srcWB.Name
            End If
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Dear mumps, once again thanks for the rapid response. However when I try to execute the code, I get an error "Compile error. constant expression required", and highlights the below line of code

Const strPath As String = ThisWorkbook.Sheets(2).Range("A1")

Please note that I have done exactly as you have mentioned above, but unable to get this in action. Can you please assist here on why we get the constant expression required error? I have attached the screenshot of error message for reference.
Thanks in advance for your support.
ragav_in

 

[mumps]

Try:

Sub CompareColumns()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet, srcWB As Workbook, strPath As String
    Set srcWS = ThisWorkbook.Sheets(1) 'this is the first sheet in Template which contains the columns to compare
    Set desWS = ThisWorkbook.Sheets("Results") 'make sure the Results sheet is not the first or second sheet
    strPath = ThisWorkbook.Sheets(2).Range("A1").Value 'this is the second sheet in Template which contains the full file path including the backslash ( \ ) at the end
                    'change the '2' and 'A1" to suit your needs
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB
            'change Range("A1:J1") to suit your needs
            If Join(Application.Transpose(Application.Transpose(.Sheets(1).Range("A1:J1").Value)), "|") <> _
                Join(Application.Transpose(Application.Transpose(srcWS.Range("A1:J1").Value)), "|") Then
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1) = srcWB.Name
            End If
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[ragav_in]

Dear mumps, once again thanks for the rapid response. However when I try to execute the code, I get an error "Compile error. constant expression required", and highlights the below line of code

Const strPath As String = ThisWorkbook.Sheets(2).Range("A1")

Please note that I have done exactly as you have mentioned above, but unable to get this in action. Can you please assist here on why we get the constant expression required error? I have attached the screenshot of error message for reference.
Thanks in advance for your support.
ragav_in

Try:

Sub CompareColumns()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWS As Worksheet, srcWB As Workbook, strPath As String
    Set srcWS = ThisWorkbook.Sheets(1) 'this is the first sheet in Template which contains the columns to compare
    Set desWS = ThisWorkbook.Sheets("Results") 'make sure the Results sheet is not the first or second sheet
    strPath = ThisWorkbook.Sheets(2).Range("A1").Value 'this is the second sheet in Template which contains the full file path including the backslash ( \ ) at the end
                    'change the '2' and 'A1" to suit your needs
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB
            'change Range("A1:J1") to suit your needs
            If Join(Application.Transpose(Application.Transpose(.Sheets(1).Range("A1:J1").Value)), "|") <> _
                Join(Application.Transpose(Application.Transpose(srcWS.Range("A1:J1").Value)), "|") Then
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1) = srcWB.Name
            End If
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Dear mumps, thanks for this update; it works and gives me the list of files that do not match the template. Heartfelt thanks for all the support extended.

Thanks,
ragav_in

 

[mumps]

You are very welcome.

 

[ragav_in]

Dear mumps, when I was using this code of yours, I noticed that if the "Case" of the Text in the Cells are not the same (upper case vs lower case), it counts that as a "not match" and writes the workbook name which should not be the case. I noticed in some thread in this forum where they have used "Case" before Join such as shown below.

Select Case Join(Application.Transpose(sh1.Range("D9:D13").Value), "|")

However if I try to use the same in our piece of code, it provides an "Expected: expression error. The code I try is as below.

If Case Join(Application.Transpose(Application.Transpose(.Sheets(1).Range("A1:N1").Value)), "|") <> _
                Case Join(Application.Transpose(Application.Transpose(srcWS.Range("A1:N1").Value)), "|") Then
                desWS.Cells(desWS.Rows.count, "A").End(xlUp).Offset(1) = srcWB.Name
End If

Can you please help me in providing a solution on how this code can be addressed to resolve the Lower/Upper case issue?

Once again, thanks for the support being provided.
Thanks
ragav_in

 

[mumps]

Try inserting this line of code

Option Compare Text

directly above this line

Sub CompareColumns()