Deleting duplicate rows from two different worksheet to a third

Hi Trish, apologies for the delay. First of all, I'm afraid there are numerous problems with your code. I have annotated some of the standout errors below, but my main query is why are you doing it that particular way? Three separate subroutines, no one routine to subsequently call them, going to the bottom of the worksheet and then back up to determine the position of the last row... I have added a subroutine to do the same thing below your code, but I'm sure there are reasons why you have gone about this task in this way.

Here are some annotations to your code, which I'm afraid do flag up typos and errors in the scope of your variable declarations:

***************

Option Explicit

Sub listduplicates()

Dim dso As Object 'Wrong scope here, needs to be a general declaration to be accessible in listuniquevalues
Dim dstwks As Worksheet
Dim lastrow As Long
Dim I As Integer
Dim R As Long
Dim shtnames As Variant
Dim wks As Worksheet

R = 2
shtnames = Array("sheet1", "sheet2", "sheet3")

'last sheet is the destination of the duplicates sheet
Set dstwks = Worksheets("sheet1", "sheet2", "sheet3,") 'Trying to load three worksheet objects into a single object variable,
'also have a comma inside "sheet3,"
dstwks.UsedRange.Offset(1, 0).ClearContents
End Sub
Sub listuniquevalues()

'create list of all unique values on "dups"
Set dso = CreateObject("scripting.dictionary") 'not generally declared above, so will fail
dso.comparemode = vbTextCompare


For I = 0 To 0
With Worksheets("sheet1", "sheet2", "sheet3")
Set Rng = .Cells(2, "A")
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row 'Why isn't .CurrentRegion.Rows.Count being used?
If lastrow >= Rng.Row Then Set Rng = Rng.Resize(lastrow + Rng.Row - 1, 1)

For Each cell In Rng
If Not dso.exists(Trim(cell.Value)) Then
dso.Add cell.Value, cell.Offset(0, 3).Value
End If
Next cell
End With
Next I
End Sub
Sub dups()

'copy values common to both sheets to the destination worksheet

Set wks = Worksheet("sheet3") 'not generally declared above, so will fail
With wks
Set Rng = .Cells(2, "A") 'Why the mixture of A1 notation and R1C1 notation? Where is Rng declared?
last Row = .Cells(Rows.Count, "A").End(xlUp).Row 'What is "last row"? This will fail
If lastrow >= Rng.Row Then Set Rng = Rng.Resize(lastrow + Rng.Row - 1, 1) 'Where's the End If?

For Each cell In Rng
If dso.exists(Trim(cell.Value)) Then
dstwks.Cells(R, "A") = cell
dstwks.Cells(R, "B") = cell.Offset(0, 3)
R = R + 1
End If

Next cell

End With

********************


...and here is quick subroutine to compare values on sheets 1 and 2 in Column A and drop any duplicates into Column A on Sheet 3:


Sub findduplicates()

Dim sourcerowcount As Integer
Dim comparepagerowcount As Integer
Dim sourceloop As Integer
Dim compareloop As Integer
Dim newlistcount As Integer

sourcerowcount = Sheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
comparepagerowcount = Sheets("Sheet2").Range("A1").CurrentRegion.Rows.Count
newlistcount = 1

For sourceloop = 1 To sourcerowcount


For compareloop = 1 To comparepagerowcount

If Sheets("sheet2").Cells(compareloop, 1).Value = Sheets("sheet1").Cells(sourceloop, 1).Value Then

Sheets("sheet3").Cells(newlistcount, 1).Value = Sheets("sheet1").Cells(sourceloop, 1).Value

newlistcount = newlistcount + 1

End If

Next compareloop

Next sourceloop

End Sub


****

I hope some of this helps. Let me know how you get on and apologies once more for the delay.

Anthony