PDA

View Full Version : Need to match every reference in sheet 2 column A for a match in Sheet 1 Column A



markpem
04-14-2015, 06:07 AM
Hello

I wonder if someone would be able to give me a bit of help, it should be quite streightfoward code wise I guess but the code snippets I have seen and tried don't seem to work. I normally put it into a macro

I have attached a "screenshot" on what I need help with.

I basically
If a match is found remove the row on Sheet 2
If a match is not found just skip it

Thanks!
13169

mancubus
04-14-2015, 07:39 AM
hi.

try this with a copy of the file:



Sub del_dupe_rows_another_sheet()

Dim i As Long, LastRowSh1A As Long, LastRowSh2A As Long
Dim LookUpRange As Range

With Worksheets("Sheet1")
LastRowSh1A = .Cells(.Rows.Count, "A").End(xlUp).Row
Set LookUpRange = .Range("A2:A" & LastRowSh1A)
End With

With Worksheets("Sheet2")
LastRowSh2A = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRowSh2A To 2 Step -1
If Application.CountIf(LookUpRange, .Cells(i, "A")) > 0 Then .Rows(i).Delete
Next i
End With

End Sub





Sub clear_dupe_cells_another_sheet()

Dim i As Long, LastRowSh1A As Long, LastRowSh2A As Long
Dim LookUpRange As Range

With Worksheets("Sheet1")
LastRowSh1A = .Cells(.Rows.Count, "A").End(xlUp).Row
Set LookUpRange = .Range("A2:A" & LastRowSh1A)
End With

With Worksheets("Sheet2")
LastRowSh2A = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRowSh2A To 2 Step -1
If Application.CountIf(LookUpRange, .Cells(i, "A")) > 0 Then .Cells(i, "A").Clear
Next i
End With

End Sub

Yongle
04-14-2015, 07:50 AM
Beaten to the draw again by @mancubus
But "variety adds to the spice of life", I'm told!

Unless you have a lot of rows, this should suit. May be slow otherwise.
How it works
It counts the number of occurrences in colA (Sheet1) of each item in colA (Sheet2)
If fewer than 1 found, it ignores, otherwise if 1 or more found, that row in sheet2 is deleted
Always delete rows from bottom up
Assumes data starts at A2 in both colA's. If not so, amend:
- Set MyRange1 = ws1.Range("A2:A" & LastR1) (for sheet1)
and
- For i = LastR2 To 2 (for sheet2)


Sub RemoveDuplicateEntriesInColumnA() Dim ws1 As Worksheet, ws2 As Worksheet
Dim MyRange1 As Range, i As Long, LastR1 As Long, LastR2 As Long
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
LastR1 = ws1.Range("A1048576").End(xlUp).Row
LastR2 = ws2.Range("A1048576").End(xlUp).Row
Set MyRange1 = ws1.Range("A2:A" & LastR1)


With ws2
For i = LastR2 To 2 Step -1
If Application.WorksheetFunction.CountIf(MyRange1, .Cells(i, 1)) < 1 Then
'step over and do nothing
Else
' tells you what is about to be deleted in sheet2
MsgBox "Delete " & .Cells(i, 1).Value
.Cells(i, 1).EntireRow.Delete
End If
Next i
End With
End Sub