Sub MisMatch()
Dim ws As Worksheet, ws1 As Worksheet
Dim Rng As Range, cel As Range
Dim LR As Long, LR1 As Long
Dim Headers() As Variant
Set ws = Sheets("Sheet1")
Set ws1 = Sheets("Sheet2")
Application.ScreenUpdating = False
With ws
'Find the Last Rows in Sheet1
LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Define the Header Row(s) to be added to Sheet2
Headers = .Range("U1").Resize(1, 4).Value
'Go to Sheet2
With ws1
.Select
'Clear all the Cells
.Cells.Clear
'Add the Header Rows
.Range("A1").Resize(1, 4).Value = Headers
.Range("G1").Resize(1, 4).Value = Headers
End With
'Define the Range in Sheet1 we wish to examine
Set Rng = .Range(.Cells(2, "U"), .Cells(LR, "U"))
'for each Cell in that Range
For Each cel In Rng
'Concatenate the Data in Columns U, V and W into Column AF
.Cells(cel.Row, "AF").Value = .Cells(cel.Row, "U") & .Cells(cel.Row, "V") & .Cells(cel.Row, "W") & .Cells(cel.Row, "X")
'Concatenate the Data in Columns AA, AB and AC into Column AG
.Cells(cel.Row, "AG").Value = .Cells(cel.Row, "AA") & .Cells(cel.Row, "AB") & .Cells(cel.Row, "AC") & .Cells(cel.Row, "AD")
Next cel
'Now, lets look at the cells in Column AF of Sheet1
Set Rng = .Range(.Cells(2, "AF"), .Cells(LR, "AF"))
'for each Cell in this Range
For Each cel In Rng
'Compare it's Value to the Value of the Cell in the adjacent Column (AG)
'if they're not the same
If Not cel.Value = cel.Offset(0, 1).Value Then
With ws1
LR1 = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
'If they're not the same, write the Values to Sheet2
.Range("A" & LR1).Resize(1, 4).Value = ws.Cells(cel.Row, "U").Resize(1, 4).Value
.Range("G" & LR1).Resize(1, 4).Value = ws.Cells(cel.Row, "AA").Resize(1, 4).Value
End With
End If
Next cel
End With
With ws
'Clean up Sheet1
.Columns("AF:AG").Delete
End With
Application.ScreenUpdating = True
End Sub
