Find the duplicate from one work book and remove the duplicates in another workbook

[satheesh]

Hi All,

Could you please help me with the code for preparing a summary report based on two workbooks both workbooks have unique identifier so need to remove the duplicates from the latest workbook and prepare a summary report.

is it possible in a way of uploading two sheets in a excel and preparing a summary sheet by removing the duplicates, please help

[anish.ms]

Attach a sample file

[satheesh]

Thank you for your reply, i have attached two sample sheets one refers to previous weeks data and one current week, so need to compare using the unique ID and remove the duplicates from the latest report that is 17-04-2021, once removed a summary report should be generated

[anish.ms]

I have moved both the sheets in to one workbook
I'm in learning stage of VBA and thought of giving a try to this; below are my codes and not sure this is what you are looking for.



Sub Assume()
Dim ws As Worksheet
Dim ay As Long, x As Integer
Application.DisplayAlerts = False

For Each ws In Worksheets
If ws.Name = "Combined" Then
Sheets("Combined").Delete
End If
Next

Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Combined"

ay = 1
For Each ws In Worksheets
If ws.Name <> "Combined" Then
ws.Range("A1").CurrentRegion.Copy Sheets("combined").Cells(ay, 1)
ay = Sheets("Combined").Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
Next

With ActiveSheet
.UsedRange.RemoveDuplicates Columns:=2, Header:=xlNo
For x = 1 To .UsedRange.Columns.Count
Columns(x).EntireColumn.AutoFit
Next x
End With

Application.DisplayAlerts = True

End Sub

[satheesh]

Thank you so much i am unable to download the attachment, however i can paste the code in my excel and try it out, so you want me to input both the data in two different sheets, and i shall get a combined summary sheet available with duplicate removed?

[anish.ms]

Yes, I will reattach the file

[anish.ms]

reattached

[satheesh]

Yes, I will reattach the file

Thank you anish this is helpful i tried the code, can you please help me with removing the duplicate completely since the in the data if there is hari in both the sheets hari should not be displayed in combined sheet since the data is duplicate, only non duplicate data should be present, is it possible for you thank you in advance.

File did not get downloded however i used the code in my sheet and it did work, but only small change as i told earlier

[satheesh]

can you please help me with the changes requested

[anish.ms]

Please find below-
This may be done in a better way; but my knowledge is limited. Request reviews from expert members



Option Explicit
Dim ay As Long
Dim iCntr As Long
Sub Assume()
Dim ws As Worksheet
Dim r As Range


Application.DisplayAlerts = False

For Each ws In Worksheets
If ws.Name = "Combined" Then
Sheets("Combined").Delete
End If
Next

Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Combined"

ay = 1
For Each ws In Worksheets
If ws.Name <> "Combined" Then
If ws.Index = 1 Then
Set r = ws.Range("A1").CurrentRegion
r.Copy Sheets("combined").Cells(ay, 1)
Else
Set r = ws.Range("A1").CurrentRegion
Set r = r.Offset(1, 0).Resize(r.Rows.Count - 1)
r.Copy Sheets("combined").Cells(ay, 1)
End If
ay = Sheets("Combined").Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
Next
Call FindDuplicatesInColumn
Call RemoveDuplicates
Application.DisplayAlerts = True

End Sub


Sub FindDuplicatesInColumn()
Dim matchFoundIndex As Long
ay = Sheets("Combined").Cells(Rows.Count, 1).End(xlUp).Row

For iCntr = 1 To ay
If Cells(iCntr, 2) <> "" Then
matchFoundIndex = WorksheetFunction.CountIf(Range("B1:B" & ay), Cells(iCntr, 2))
If matchFoundIndex > 1 Then
Cells(iCntr, 6) = "Duplicate"
End If
End If
Next
End Sub


Sub RemoveDuplicates()


With Sheets("Combined")
For iCntr = ay To 2 Step -1
If Cells(iCntr, 6) = "Duplicate" Then Rows(iCntr).Delete
Next

For iCntr = 1 To .UsedRange.Columns.Count
Columns(iCntr).EntireColumn.AutoFit
Next iCntr
End With
End Sub

[satheesh]

Thank you Anish this is very velpfull shall replicate it in my requirement and get back to you if any doubts, you are a star man :)