Compare 2 worksheets for difference

HECGroups

Board Regular
Joined
Jan 16, 2012
Messages
164
Hello Again,

Referring to the link HERE . Can someone help me please.

Code:
I am looking for VBA macros to compare 2 worksheets within same workbook. I am always receiving more than 10,000 to 50,000 member’s data on daily basis.

 Compare worksheet (Quote List) with worksheet (Policy Issuance List) based on ID number in column H. if difference found then copy entire row to worksheet (Discrepancy Records) and highlight cell value which is changed.

 For Example: 

 In worksheet (Quote List) look for ID number “2099421261” i.e. row no. 1 in worksheet (Policy Issuance List) i.e. row no. 3 and found difference in age. So, copy the entire row to worksheet (Discrepancy Records) and highlight cell value E2 in worksheet (Discrepancy Records).

 I hope that above details are sufficient to understand my problem.

 Copy of a sample worksheet is attached for your reference.
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
I have end up with below code.

But the only issue is mentioned below remain.

1. It is not finding newly record which is not exists in the "Quote List" worksheet and present in "Policy Issuance List" worksheet.
2. It is not finding removed record which is exist in the "Quote List " worksheet and not present in "Policy Issuance List" worksheet.
3. It is not returning the remarks.

Code:
Sub Generate_Discrepancies()
Dim ws1 As Worksheet:   Set ws1 = Sheets("Quote List")
Dim ws2 As Worksheet:   Set ws2 = Sheets("Policy Issuance List")
Dim ws3 As Worksheet:   Set ws3 = Sheets("Discrepancy Records")
Dim c As Range, rng1 As Range, rng2 As Range, rFind As Range
Dim b As Boolean
Dim i As Integer

Application.ScreenUpdating = False

Set rng1 = ws1.Range("H2:H" & ws1.Range("H" & Rows.Count).End(xlUp).Row)
Set rng2 = ws2.Range("H2:H" & ws2.Range("H" & Rows.Count).End(xlUp).Row)

For Each c In rng1
    b = False
    Set rFind = rng2.Find(c, , xlValues, xlWhole)
    If Not rFind Is Nothing Then
        For i = 2 To 11 'B to K
            If Trim(ws1.Cells(c.Row, i)) <> Trim(ws2.Cells(rFind.Row, i)) Then
                If b = False Then
                    c.EntireRow.Copy ws3.Range("A" & Rows.Count).End(3)(2)
                    b = True
                End If
                ws3.Cells(ws3.Range("A" & Rows.Count).End(xlUp).Row, i).Interior.ColorIndex = 47
                ws3.Cells(ws3.Range("A" & Rows.Count).End(xlUp).Row, i).Font.Color = vbWhite
            End If
        Next i
    Else
        'Removed Records
        c.EntireRow.Copy ws3.Range("A" & Rows.Count).End(3)(2)
    End If
Next c

Application.ScreenUpdating = True

End Sub
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,923
Members
448,533
Latest member
thietbibeboiwasaco

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