PDA

View Full Version : compare 2 sheet and all column if find duplicate will delete on sheet 2



parscon
01-09-2014, 01:40 PM
i have this VBA code ,

if will check all column of sheet 1 from A1:Z and if find duplicate data on sheet 2 it will delete that row on sheet 2 and the problem is this code will check only column A on sheet2 , i need to check all column on sheet 2 and i know there must be something in this section of code



' To specify a different column, change 1 to the column number.
If x.Value = Sheets("Sheet2").Cells(iCtr, 1).Value Then


could you please help to find a solution to check all column of sheet2 also .



Sub DelDups_TwoLists()
Dim iListCount As Integer
Dim iCtr As Integer

' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False

' Get count of records to search through (list that will be deleted).
iListCount = Sheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Row

' Loop through the "master" list.
For Each x In Sheets("Sheet1").Range("A1:Z" & Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row)
' Loop through all records in the second list.
For iCtr = iListCount To 1 Step -1
' Do comparison of next record.
' To specify a different column, change 1 to the column number.
If x.Value = Sheets("Sheet2").Cells(iCtr, 1).Value Then
' If match is true then delete row.
Sheets("Sheet2").Cells(iCtr, 1).EntireRow.Delete

End If

Next iCtr
Next
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub

Teeroy
01-10-2014, 12:00 AM
Using .Find is a much quicker way of running this sort of check, otherwise you loop through the second sheet (no. of cells in sheet 1 range) times. Try the following on a COPY of your data first.



Sub DeleteMatchedRows()
Dim rSrc As Range, rTest As Range, rMatch As Range, rng As Range

Set rSrc = Intersect(Sheets("Sheet1").UsedRange, Sheets("Sheet1").Range("A1:Z1").EntireColumn)
For Each rng In rSrc
Set rTest = Intersect(Sheets("Sheet2").UsedRange, Sheets("Sheet2").Range("A1:Z1").EntireColumn)
If rTest.Cells.Count = 1 Then
If rTest = "" Then Exit Sub
End If
Set rMatch = rTest.Find(rng.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not rMatch Is Nothing Then
Do
rMatch.EntireRow.Delete
Set rTest = Intersect(Sheets("Sheet2").UsedRange, Sheets("Sheet2").Range("A1:Z1").EntireColumn)
If rTest.Cells.Count = 1 Then
If rTest = "" Then Exit Sub
End If
Set rMatch = rTest.Find(rng.Value, after:=rTest.Cells(1, 1), LookIn:=xlValues, lookat:=xlWhole)
Loop While Not rMatch Is Nothing
End If
Next
End Sub


Hope this helps.

parscon
01-10-2014, 01:47 AM
Thank you for your help , but the code have some problem it will delete all my column and row on sheet2

i added a sample file , it must delete only one row on sheet2 but it will delete all of them

it must delete only row 19846 .