Please help with a "find duplicates" macro - 4/10/07

G

Guest

A while back someone was very helpful in solving a macro problem.
I need a little more assistance. The macro compared "Column A" in two
worksheets (Master & Sub) and identified the duplicates by changing the cell
background to red.. When the macro encountered it's first blank cell in the
Master sheet the macro stopped running. This Macro worked great.

I still need to compare the two worksheets "Column A" but when the macro
sees duplicates it needs to delete the entire row in the Master worksheet.
Below is the Macro I have been using... I am not sure if this macro can be
modified or need a complete new macro? Any assistance would be appreciated.

Sub FindDupes() 'assuming both sheets are in same book and book is open
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim cell1 As Range
Dim cell2 As Range
Dim str As String
str = InputBox("Type name of first sheet")
Set sht1 = Worksheets(str)
str = InputBox("Type name of second sheet")
Set sht2 = Worksheets(str)
For Each cell1 In sht1.Columns(1).Cells
If cell1.Value = "" Then Exit Sub
For Each cell2 In sht2.Columns(1).Cells
If cell2.Value = cell1.Value Then
cell1.Interior.ColorIndex = 3
cell2.Interior.ColorIndex = 3
End If
Next cell2
Next cell1
End Sub
 
R

Rodrigo Ferreira

Something like this:

....
'cell1.Interior.ColorIndex = 3
'cell2.Interior.ColorIndex = 3
sht1.Rows(cell1.Row & ":" & cell1.Row).Delete Shift:=xlUp
....
 
G

Guest

Hi Rodrigo,
I edited the macro per your suggestion.
The Macro stops and highlights in yellow the line...If cell2.Value =
cell1.Value Then
The error indicates it looking for a value?

I ran the macro both with an without the comment indicator in front of the
lines
' cell1.Interior.ColorIndex = 3
' cell2.Interior.ColorIndex = 3
didn't seem to make any difference.

Here is the entire macro with your suggested change

Sub FindDupes() 'assuming both sheets are in same book and book is open
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim cell1 As Range
Dim cell2 As Range
Dim str As String
str = InputBox("Type name of first sheet")
Set sht1 = Worksheets(str)
str = InputBox("Type name of second sheet")
Set sht2 = Worksheets(str)
For Each cell1 In sht1.Columns(1).Cells
If cell1.Value = "" Then Exit Sub
For Each cell2 In sht2.Columns(1).Cells
If cell2.Value = cell1.Value Then
‘ cell1.Interior.ColorIndex = 3
‘ cell2.Interior.ColorIndex = 3
sht1.Rows(cell1.Row & ":" & cell1.Row).Delete Shift:=xlUp
End If
Next cell2
Next cell1
End Sub
***********************************************************
 
R

Rodrigo Ferreira

Look this code:

Sub FindDupes() 'assuming both sheets are in same book and book is open
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim cell1 As Range
Dim cell2 As Range
Dim str As String
'str = InputBox("Type name of first sheet")
str = "Plan1"
Set sht1 = Worksheets(str)
'str = InputBox("Type name of second sheet")
str2 = "Plan2"
Set sht2 = Worksheets(str2)

sht1.Range("A65536").End(xlDown).Activate
Selection.End(xlUp).Activate
LastRowSht1 = ActiveCell.Row

sht2.Activate
sht2.Range("A65536").End(xlDown).Activate
Selection.End(xlUp).Activate
LastRowSht2 = ActiveCell.Row

sht1.Activate
For rowSht1 = 1 To LastRowSht1
If sht1.Cells(rowSht1, 1) = "" Then Exit Sub
For rowSht2 = 1 To LastRowSht2
If sht1.Cells(rowSht1, 1).Value = sht2.Cells(rowSht2, 1).Value
Then
sht1.Cells(rowSht1, 1).Interior.ColorIndex = 3
sht2.Cells(rowSht2, 1).Interior.ColorIndex = 3
sht1.Rows(rowSht1 & ":" & rowSht1).Delete Shift:=xlUp
End If
Next
Next
sht1.Cells(1, 1).Select
End Sub
 
G

Guest

Rodrigo, I do thank you for you help.

I ran your macro but it came up with a "compile error" at this line
If sht1.Cells(rowSht1, 1).Value = sht2.Cells(rowSht2, 1).Value
Then
 
G

Gord Dibben

You have run into line-wrap.

Those two lines should be all one line or use a line continuation character (_)

If sht1.Cells(rowSht1, 1).Value = sht2.Cells(rowSht2, 1).Value _
Then


Gord Dibben MS Excel MVP
 
G

Guest

Gord, I revise the Macro per your suggestion...I still get a "Compile Syntax
Error"

Could the problem be the line position of text?
I noticed Set sht1 = Worksheets(str) vs Set sht2 = Worksheets(str2)
Should it read - "Set sht1 = Worksheets(str1)" ??

Here is my current Macro, I added the continuation character (_)

Sub FindDupes() 'assuming both sheets are in same book and book is open
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim cell1 As Range
Dim cell2 As Range
Dim str As String
'str = InputBox("Type name of first sheet")
str1 = "Plan1"
Set sht1 = Worksheets(str)
'str = InputBox("Type name of second sheet")
str2 = "Plan2"
Set sht2 = Worksheets(str2)

sht1.Range("A65536").End(xlDown).Activate
Selection.End(xlUp).Activate
LastRowSht1 = ActiveCell.Row

sht2.Activate
sht2.Range("A65536").End(xlDown).Activate
Selection.End(xlUp).Activate
LastRowSht2 = ActiveCell.Row

sht1.Activate
For rowSht1 = 1 To LastRowSht1
If sht1.Cells(rowSht1, 1) = "" Then Exit Sub
For rowSht2 = 1 To LastRowSht2
If sht1.Cells(rowSht1, 1).Value = sht2.Cells(rowSht2, 1).Value_
Then
sht1.Cells(rowSht1, 1).Interior.ColorIndex = 3
sht2.Cells(rowSht2, 1).Interior.ColorIndex = 3
sht1.Rows(rowSht1 & ":" & rowSht1).Delete Shift:=xlUp
End If
Next
Next
sht1.Cells(1, 1).Select
End Sub
 
P

Pete_UK

You need to have a <space> before the continuation character, i.e.:

If sht1.Cells(rowSht1, 1).Value = sht2.Cells(rowSht2, 1).Value _
Then

Hope this helps.

Pete
 
G

Guest

Thank you, I added the space....

I now get - Run time error "9" Subscript out of range

I tried repositioning the text to left justified and also changed (str) to
(str1)
I still get the same error....
 
R

Rodrigo Ferreira

Plan1 and Plan2 = The name of your worksheet

'str1 = InputBox("Type name of first sheet")
str1 = "TheNameOfYourWorksheet1"
Set sht1 = Worksheets(str1)
'str = InputBox("Type name of second sheet")
str2 = "TheNameOfYourWorksheet2"
Set sht2 = Worksheets(str2)

Or remove the comment of
'str = InputBox("Type name of first sheet")

Like this:
str1 = InputBox("Type name of first sheet")
'str1 = "TheNameOfYourWorksheet1"
Set sht1 = Worksheets(str1)
str = InputBox("Type name of second sheet")
'str2 = "TheNameOfYourWorksheet2"
Set sht2 = Worksheets(str2)
 
G

Guest

I renamed my worksheets to Plan1 & Plan2
'str = InputBox("Type name of first sheet")
str1 = "Plan1"
Set sht1 = Worksheets(str) = run time error line "9"
'str = InputBox("Type name of second sheet")
str2 = "Plan2"
Set sht2 = Worksheets(str2)

I put identical data in column A rows 11 & 12 of both worksheets, macro did
not delete the rows..?

Would it help if I emailed you reduced version of my speadsheet??
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top