Comparing two pairs of sheets(A with B AND C with D) and applying conditions

rkfuture

New Member
Joined
Sep 19, 2022
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
The code Compares the row headers and Column headers of Sheets(1) with Sheets (2) and Sheets (3) with Sheets (4).

Whenever a difference is found in a header, first the destination of the difference is located, then an empty row/column is inserted and then the values are copied and pasted from the extra row/column to the new inserted row/column.

Now, the problem is that this only works if the extra header is present in the second sheet of the pairs (i.e, Sheets(2) and Sheets(4)). It always expects that the extra header will always be in the second sheet. I am hoping to figure out a way that after comparing both sheets for differences, irrespective of where the extra header is found, it identifies that sheet and inserts the header to the corresponding sheet.

Basically, what I am trying to do is to make both sheets have the same headers (that is the same first row and same first column in the exact same order.)

I hope my explanation is clear! Please feel free to ask, if you need to know something else. Thanks

VBA Code:
LastRow1 = Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row
lastRow2 = Sheets(2).Cells(Sheets(2).Rows.Count, "A").End(xlUp).Row
LastRow3 = Sheets(3).Cells(Sheets(3).Rows.Count, "A").End(xlUp).Row
lastRow4 = Sheets(4).Cells(Sheets(4).Rows.Count, "A").End(xlUp).Row

For i = 1 To lastRow2
foundTrue = False
For j = 1 To LastRow1

    If Sheets(2).Cells(i, 1).Value = Sheets(1).Cells(j, 1).Value Then
        foundTrue = True
        Exit For
    End If

Next j

If Not foundTrue Then


    Sheets(1).Rows(i).EntireRow.Insert Shift:=xlShiftDown
    Sheets(2).Cells(i).Copy Destination:= _
    Sheets(1).Cells(i, 1)
    Sheets(2).Cells(i, 1).Copy
    Sheets(1).Cells(i, 1).PasteSpecial Paste:=xlPasteValues
    
End If

Next i

For m = 1 To lastRow4
foundTrue = False
For n = 1 To LastRow3

    If Sheets(4).Cells(m, 1).Value = Sheets(3).Cells(n, 1).Value Then
        foundTrue = True
        Exit For
    End If

Next n

If Not foundTrue Then
    Sheets(3).Rows(m).EntireRow.Insert Shift:=xlShiftDown
    Sheets(4).Cells(m).Copy Destination:= _
    Sheets(3).Cells(m, 1)
    Sheets(4).Cells(m, 1).Copy
    Sheets(3).Cells(m, 1).PasteSpecial Paste:=xlPasteValues
    
End If

Next m



Application.ScreenUpdating = False


LastCol1 = Sheets(1).Cells(1, Columns.Count).End(xlToRight).Column
lastcol2 = Sheets(2).Cells(1, Columns.Count).End(xlToRight).Column
Lastcol3 = Sheets(3).Cells(1, Columns.Count).End(xlToRight).Column
lastcol4 = Sheets(4).Cells(1, Columns.Count).End(xlToRight).Column

For x = 1 To lastcol2
foundTrue = False
For y = 1 To LastCol1

    If Sheets(2).Cells(1, x).Value = Sheets(1).Cells(1, y).Value Then
        foundTrue = True
        Exit For
    End If

Next y

If Not foundTrue Then
    Sheets(1).Columns(x).EntireColumn.Insert Shift:=xlShiftToRight
    Sheets(2).Cells(x).Copy Destination:= _
    Sheets(1).Cells(1, x)
    Sheets(2).Cells(1, x).Copy
    Sheets(1).Cells(1, x).PasteSpecial Paste:=xlPasteValues
    
End If

Next x

For z = 1 To lastcol4
foundTrue = False
For w = 1 To Lastcol3

    If Sheets(4).Cells(1, z).Value = Sheets(3).Cells(1, w).Value Then
        foundTrue = True
        Exit For
    End If

Next w

If Not foundTrue Then
    Sheets(3).Columns(z).EntireColumn.Insert Shift:=xlShiftToRight
    Sheets(4).Cells(z).Copy Destination:= _
    Sheets(3).Cells(1, z)
    Sheets(4).Cells(1, z).Copy
    Sheets(3).Cells(1, z).PasteSpecial Paste:=xlPasteValues
    
End If

Next z

Application.ScreenUpdating = True
 
Last edited by a moderator:

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

Forum statistics

Threads
1,224,823
Messages
6,181,171
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top