Hello!
I have some VBA code to find duplicate values between two sheets (Sheet1 and Sheet2)
Sub t()
Dim c As Range, fn As Range, adr As String
With Sheets("sheet1")
For Each c In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
Set fn = Sheets("sheet2").Range("A:A").Find(c.Value, , xlValues, xlWhole)
If Not fn Is Nothing Then
adr = fn.Address
c.Interior.Color = RGB(400, 200, 100)
Do
fn.Interior.Color = RGB(400, 200, 100)
Set fn = Sheets("Sheet2").Range("A:A").FindNext(fn)
Loop While fn.Address <> adr
End If
Next
End With
End Sub
But I need it to clear the duplicate contents from Sheet 1, after it finds them.
Ideally, I'd like a message to appear first before removal.
The process would be
1. Check for duplicate values between two sheets
2. Highlight duplicate values
3. Message stating "Duplicates found, would you like to remove?"
4. If selecting yes, then removing the duplicates from Sheet 1
5. If selecting no, then keeping the duplicates highlighted.
Thanks in advance!!
I have some VBA code to find duplicate values between two sheets (Sheet1 and Sheet2)
Sub t()
Dim c As Range, fn As Range, adr As String
With Sheets("sheet1")
For Each c In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
Set fn = Sheets("sheet2").Range("A:A").Find(c.Value, , xlValues, xlWhole)
If Not fn Is Nothing Then
adr = fn.Address
c.Interior.Color = RGB(400, 200, 100)
Do
fn.Interior.Color = RGB(400, 200, 100)
Set fn = Sheets("Sheet2").Range("A:A").FindNext(fn)
Loop While fn.Address <> adr
End If
Next
End With
End Sub
But I need it to clear the duplicate contents from Sheet 1, after it finds them.
Ideally, I'd like a message to appear first before removal.
The process would be
1. Check for duplicate values between two sheets
2. Highlight duplicate values
3. Message stating "Duplicates found, would you like to remove?"
4. If selecting yes, then removing the duplicates from Sheet 1
5. If selecting no, then keeping the duplicates highlighted.
Thanks in advance!!