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

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

Forum statistics

Threads
1,223,894
Messages
6,175,250
Members
452,623
Latest member
Techenthusiast

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