deleting duplicate rows two

Public Schedule Face-to-Face & Online Instructor-Led Training - View dates & book

Forum home » Delegate support and help forum » Microsoft Excel VBA Training and help » Deleting duplicate rows from two different worksheet to a third

Deleting duplicate rows from two different worksheet to a third

resolvedResolved · High Priority · Version 2007

Edited on Tue 5 Apr 2011, 15:21

Patricia has attended:
Excel VBA Intro Intermediate course

Deleting duplicate rows from two different worksheet to a third

I have entered the following code to compare two worksheets showing duplicates in a list on a third sheet.
it wont work and not sure what Ive done wrong. Any help would be greatly appreciated.


Sub listduplicates()

Dim dso As Object
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,")
dstwks.UsedRange.Offset(1, 0).ClearContents
End Sub
Sub listuniquevalues()

'create list of all unique values on "dups"
Set dso = CreateObject("scripting.dictionary")
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
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")
With wks
Set rng = .Cells(2, "A")
last Row = .Cells(Rows.Count, "A").End(xlUp).Row
If lastrow >= rng.Row Then Set rng = rng.Resize(lastrow + rng.Row - 1, 1)

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










End Sub

RE: deleting duplicate rows from two different worksheet to a th

Hi Patricia

Thanks for your question

Could you please advise in what way the code does not work. Does it crash, if so what is the error number and message and on what line of code does it fall over. Or does it produce incorrect results, if so what is the nature of these results

Thanks

Stephen

RE: deleting duplicate rows from two different worksheet to a th

I get a message box saying
compile error
wrong number of arguments or invalid property assignments.

RE: deleting duplicate rows from two different worksheet to a th

Hi Patricia,

Are you still experiencing the same problem with your code or have you managed to resolve it?

Regards

Simon

RE: deleting duplicate rows from two different worksheet to a th

Hi Simon, Yes im still having the same problem. i raised it to a higher priority in the hope I might get a reply. Really disappointed as Best stl made a bigh thing about the support forum and how good it was. It doesnt seem to add up.

Regards
Trish

RE: deleting duplicate rows from two different worksheet to a th

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

RE: deleting duplicate rows from two different worksheet to a th

Thanks Anthony, I will use the code you've given me when i get back to work.

regards
trish

 

Training courses

 

Training information:

Welcome. Please choose your application (eg. Excel) and then post your question.

Our Microsoft Qualified trainers will then respond within 24 hours (working days).

Frequently Asked Questions
What does 'Resolved' mean?

Any suggestions, questions or comments? Please post in the Improve the forum thread.


 

Excel tip:

Outlining - ungrouping rows or columns

Highlight want you want to ungroup and press ALT + SHIFT + right cursor arrow

View all Excel hints and tips


Server loaded in 0.08 secs.