VBA code for reconciliation

[Anthony86]

Hi all,

I've done some searching and found a code that works reasonable well for what I need, but I do need a little help to edit it. The below code looks in two different tabs within the same spreadsheet and finds and discrepancies, then copies the rows over to a 3rd tab, pasting them 1 under the other. What I would like it to do is, have them side by side, and also highlight the cells in the first two tabs.

This is the code.

Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet
    Dim lr1 As Long, lr2 As Long, rng1 As Range, rng2 As Range, c As Range
    Set sh1 = Worksheets("Tab1")
    Set sh2 = Worksheets("Tab2")
    Set sh3 = Worksheets("Tab3")
    lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'Get the last row with data for both list sheets
    lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
                'Establish the ranges on both sheets
    Set rng1 = sh1.Range("B2:C" & lr1)
    Set rng2 = sh2.Range("B2:C" & lr2)
    With sh3 'If header not there, put them in
        If .Range("A1") = "" Then
            .Range("A1") = "Header"
            .Range("B1") = "Header"
            .Range("C1") = "Header"
            .Range("D1") = "Header"
            .Range("E1") = "Header"
        End If
    End With
   For Each c In rng1 'Run a loop for each list ID mismatches and paste to sheet 3.
        If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
            'sh3.Cells(Rows.Count, 1).End(xlUp)(2) = c.Value
            sh1.Rows(c.Row).Copy sh3.Cells(sh3.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
            sh2.Rows(c.Row).Copy sh3.Cells(sh3.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
        End If
    Next
End Sub

Any help will be greatly appreciated.

 

[NdNoviceHlp]

Seems like this should work (untested)….

Dim RowTemp As Integer
For Each c In rng1
If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
c.DisplayFormat.Interior.ColorIndex = 3 'red
RowTemp = sh3.Cells(Rows.Count, 1).End(xlUp).Row + 1
sh1.Rows(c.Row).Copy sh3.Cells(RowTemp, 1)
sh2.Rows(c.Row).Copy sh3.Cells(RowTemp, 2)
End If
Next c

HTH. Dave

 

[Anthony86]

Thanks for the response, and sorry for the slow reply. I just tested this code and it works fine on the first copy, but on the 2nd it fails.

sh2.Rows(c.Row).Copy sh3.Cells(RowTemp, 2)

Something about the copy area, and paste area being different sizes

 

[NdNoviceHlp]

Not exactly sure where U want stuff... rows side by side?

Dim RowTemp As Integer, LastCol As Integer
For Each c In rng1
If WorksheetFunction.CountIf(Rng2, c.Value) = 0 Then
c.Interior.ColorIndex = 3 'red
RowTemp = sh3.Cells(Rows.Count, 1).End(xlUp).Row + 1
sh1.Rows(c.Row).Copy sh3.Cells(RowTemp, 1)
With Sheets("sh3")
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
sh2.Rows(c.Row).Copy sh3.Cells(RowTemp, LastCol)
End If
Next c

See what happens. Dave

 

[Anthony86]

Hi Dave,

Yes I want the stuff side by side. I have 5 columns in my first two tabs(A-E), when the data doesn't match then I need it to copy both data sets and place in a 3rd tab from A-E, then G-K.(side by side).

I just tried the code above and I still get the same error message regarding copy/paste area.

Regards,

 

[NdNoviceHlp]

Yes because I screwed that up. Trial this...

Dim RowTemp As Integer, LastCol As Integer
For Each c In rng1
If WorksheetFunction.CountIf(Rng2, c.Value) = 0 Then
c.Interior.ColorIndex = 3 'red
RowTemp = sh3.Cells(Rows.Count, 1).End(xlUp).Row + 1
sh1.Rows(c.Row).Copy sh3.Cells(RowTemp, 1)
With Sheets("sh3")
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
sh2.Rows(c.Row).Copy sh3.Cells(RowTemp, LastCol + 1)
End If
Next

Dave

 

[Anthony86]

Hi Dave,

Still the same error message.

Run Time Error '1004'
You can't paste this here because the copy area and paste area aren't the same size.

Selecting just one cell in the paste area or an area that's the same size, and try pasting again.

 

[NdNoviceHlp]

Yes I guess U would get that error when your trying to paste a whole row on top of another row. I really should have looked at this more carefully... my apologies. After some limited testing this seems to work. Dave

Option Explicit
Sub test()
Dim RowTemp As Integer, LastCol As Integer, Lr1 As Integer, Lr2 As Integer
Dim C As Range, Rng1 As Range, Rng2 As Range, NewRng As Range, NewRng2 As Range

With Sheets("Sh1")
Lr1 = .Range("B" & .Rows.Count).End(xlUp).Row
End With
With Sheets("Sh2")
Lr2 = .Range("B" & .Rows.Count).End(xlUp).Row
End With

Set Rng1 = Sheets("sh1").Range("B2:C" & Lr1)
Set Rng2 = Sheets("sh2").Range("B2:C" & Lr2)
Rng1.Interior.Color = xlNone

For Each C In Rng1
If WorksheetFunction.CountIf(Rng2, C.Value) = 0 Then
C.Interior.ColorIndex = 3 'red
RowTemp = Sheets("sh3").Cells(Sheets("sh3").Rows.Count, 1).End(xlUp).Row + 1
Set NewRng = Sheets("sh1").Range("A" & C.Row & ":E" & C.Row)
NewRng.Copy Sheets("sh3").Range("A" & RowTemp)
Application.CutCopyMode = False

With Sheets("sh3")
LastCol = .Cells(RowTemp, .Columns.Count).End(xlToLeft).Column
End With
Set NewRng2 = Sheets("sh2").Range("A" & C.Row & ":E" & C.Row)
NewRng2.Copy Sheets("sh3").Cells(RowTemp, LastCol + 2)
Application.CutCopyMode = False
End If
Next C
End Sub

 

[Anthony86]

Hi Dave, Just tested this and it works a charm! Thanks for all your help very much appreciated.

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. Dave