Forum home » Delegate support and help forum » Microsoft Excel VBA Training and help » Deleting duplicate rows from two different worksheet to a third
|
|
|
The UK's most regular 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
Any suggestions, questions or comments? Please post in the Improve the forum thread. |
Deleting duplicate rows from two different worksheet to a third
Resolved · High Priority · Version 2007
Reply Tue 5 Apr 2011, 15:19
Edited on Tue 5 Apr 2011, 15:21Delegate Patricia said...
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
For upcoming training course dates see: Pricing & availability
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
Reply Tue 12 Apr 2011, 07:57Delegate Patricia said...
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
Reply Wed 20 Apr 2011, 18:14Delegate Patricia said...
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
Reply Fri 22 Apr 2011, 13:33Delegate Patricia said...
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
|