Duplcate Rows for 5 Sheets

[Str8goofE]

I copied a Macro from Chip Pearson's site that deletes duplicate rows if there
is a duplicate entry in a specified column(shown below)...is there anyway to
get this Macro to work on 5 worksheets by simply comparing the same column in
each of the 5 worksheets?

Thanks!

Public Sub DeleteDuplicateRows()
'
' This macro deletes duplicate rows in the selection. Duplicates are
' counted in the COLUMN of the active cell.

Dim Col As Integer
Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Col = ActiveCell.Column

If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If

N = 0
For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, 1).Value
If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
Rng.Rows(r).EntireRow.Delete
N = N + 1
End If
Next r

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

[Dave Peterson]

There was a mistake in the previous post. I was deleting the row if I found a
duplicate in the sheet or on any other sheet. I should only delete the row if
there was a duplicate on the same sheet.

But the other notes are correct (as far as I can tell). Test it against a copy
of your workbook:

Chip's macro will keep the first value and delete the duplicated values.

So are you looking for the same thing. If you have 5 sheets (sheet1-sheet5), do
you want to start on the first, then check each to see if there is a duplicate
on that sheet. If yes then delete all the duplicates from each sheet and just
keep the first occurence in that first sheet?

I think it might be quicker to merge the worksheets together into one, then run
Chip's macro, then separate the pieces again.

But this appeared to work ok for me:

Option Explicit

Public Sub DeleteDuplicateRows()

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim Col As Integer

Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant

Dim Rng() As Range
Dim myCol As String
Dim i As Long
Dim j As Long
Dim myWks As Variant
Dim TotalFound As Long
Dim r1 As Long

myCol = "C"

myWks = Array("sheet1", "sheet2", "sheet3", "sheet4", "sheet5")

ReDim Rng(LBound(myWks) To UBound(myWks))

For i = LBound(myWks) To UBound(myWks)
With Worksheets(myWks(i))
On Error Resume Next
Set Rng(i) = Intersect(.UsedRange, .Cells(1, myCol).EntireColumn)
On Error GoTo 0
End With
Next i

For i = LBound(Rng) To UBound(Rng)
TotalFound = 0
For r = Rng(i).Rows.Count To 1 Step -1
V = Rng(i).Cells(r, 1).Value
TotalFound = 0
For j = i + 1 To UBound(Rng)
If Rng(j) Is Nothing Then
'do nothing
Else
TotalFound = TotalFound +
Application.WorksheetFunction.CountIf(Rng(j).Columns(1), V)
End If
Next j

'this is where I fixed it.
If Application.WorksheetFunction.CountIf(Rng(i).Columns(1), V) > 1 Then
Rng(i).Rows(r).EntireRow.Delete
End If

'and here, too.
If TotalFound > 0 Then
For j = i + 1 To UBound(Rng)
If Rng(j) Is Nothing Then
'do nothing
Else
If Application.WorksheetFunction.CountIf(Rng(j).Columns(1),
V) > 0 Then
For r1 = Rng(j).Rows.Count To 1 Step -1
If Rng(j)(r1).Value = V Then
Rng(j).Rows(r1).EntireRow.Delete
End If
Next r1
End If
End If
Next j
End If
Next r
Next i

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

It looks in the cells in the worksheet that's being processed. And it looks at
the other sheets, too. If it finds a duplicate anywhere, it deletes that row.
Then it goes off and tries to delete the other duplicates on the other sheets.

Since we clean up duplicates on the way, we can get by with just looking at the
worksheets higher in the list:

myWks = Array("sheet1", "sheet2", "sheet3", "sheet4", "sheet5")

After sheet1 is cleaned up, then there's no reason to ever look at that one when
we're doing sheet2. Same thing with sheet1&sheet2 when we're on sheet3 (and so
forth).

=====
With small amount of data, this doesn't look too bad. But with lots, I think
I'd merge them all and do the deletes once and separate them.

--

Dave Peterson
ec3...@msn.com

[Dave Peterson]

Chip's macro will keep the first value and delete the duplicated values.

So are you looking for the same thing. If you have 5 sheets (sheet1-sheet5), do
you want to start on the first, then check each to see if there is a duplicate
on that sheet. If yes then delete all the duplicates from each sheet and just
keep the first occurence in that first sheet?

I think it might be quicker to merge the worksheets together into one, then run
Chip's macro, then separate the pieces again.

But this appeared to work ok for me:

Option Explicit

Public Sub DeleteDuplicateRows()

On Error GoTo EndMacro

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim Col As Integer

Dim r As Long
Dim C As Range
Dim N As Long
Dim V As Variant

Dim Rng() As Range

ReDim Rng(LBound(myWks) To UBound(myWks))

TotalFound = TotalFound + _

Application.WorksheetFunction.CountIf(Rng(j).Columns(1), V)
End If
Next j

If Application.WorksheetFunction.CountIf(Rng(i).Columns(1), V) > 1 _
Or TotalFound > 0 Then
Rng(i).Rows(r).EntireRow.Delete
End If

For j = i + 1 To UBound(Rng)
If Rng(j) Is Nothing Then
'do nothing
Else

If Application.WorksheetFunction _
.CountIf(Rng(j).Columns(1), V) > 0 Then

For r1 = Rng(j).Rows.Count To 1 Step -1
If Rng(j)(r1).Value = V Then
Rng(j).Rows(r1).EntireRow.Delete
End If
Next r1
End If
End If
Next j

Next r
Next i

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

It looks in the cells in the worksheet that's being processed. And it looks at

the other sheets, too. If it finds a duplicate anywhere, it deletes that row.
Then it goes off and tries to delete the other duplicates on the other sheets.

Since we clean up duplicates on the way, we can get by with just looking at the
worksheets higher in the list:

myWks = Array("sheet1", "sheet2", "sheet3", "sheet4", "sheet5")

After sheet1 is cleaned up, then there's no reason to ever look at that one when
we're doing sheet2. Same thing with sheet1&sheet2 when we're on sheet3 (and so
forth).

=====
With small amount of data, this doesn't look too bad. But with lots, I think
I'd merge them all and do the deletes once and separate them.

--

Dave Peterson
ec3...@msn.com

[Tom Ogilvy]

untested, but I believe this will do what you want. Change Col = 5 to refer
to the column where you want the comparison.

Public Sub DeleteDuplicateRows()
'
' This macro deletes duplicate rows based on a duplicate value in
' the column specified in the statement Col =

Dim Col As Integer
Dim r As Long
Dim C As Range

Dim V As Variant
Dim Rng As Range

Dim shArray

Col = 5 ' column E - set to your column

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

shArray = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")

For k = UBound(shArray) To LBound(shArray)
shArray(k).Activate

Set Rng = ActiveSheet.UsedRange.Rows( _
ActiveSheet.UsedRange.Rows.Count).Row

N = 0
For r = Rng.Row To 1 Step -1
V = Cells(r, Col).Value
For l = k To LBound(shArray)
If l = k Then
If Application.WorksheetFunction.CountIf(Columns(Col), V) > 1 Then
Cells(r, Col).EntireRow.Delete
Exit For
End If
Else
If Application.CountIf(shArray(l).Columns(Col), V) > 0 Then
Cells(r, Col).EntireRow.Delete
Exit For
End If
End If
Next l
Next r

Next k
EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Regards,
Tom Ogilvy

"Str8goofE" <str8...@aol.com> wrote in message
news:20021220142623...@mb-mv.aol.com...

[Str8goofE]

Hi Dave,

The reason why I cannot merge them is because I have like 250,000 records.
Will this compare the column C in ALL worksheets and delete duplicates or just
each worksheet itself and delete only duplicates in that particular worksheet?

This file is huge and really slow, is there any other options to delete
duplicates and get this accomplished?

Thanks for any help.

[Dave Peterson]

Try it against a small workbook!

But I'm not too sure how fast it'll be with the giant workbook.

--

Dave Peterson
ec3...@msn.com

[Str8goofE]

>Try it against a small workbook!
>
>But I'm not too sure how fast it'll be with the giant workbook.

Dave I already have it running on a large workbook :) I wish I would have had
my thinking cap on and tested it on a small one first. It has been running for
30 minutes so far...haha

[Dave Peterson]

Next time, put:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

at the top and

Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic

at the bottom.

And if you you have those dotted lines (that represent page breaks), turn them
off with something like:

dim wks as worksheet
for each wks in activeworkbook.worksheets
wks.displayPageBreaks = False
next wks

Excel slows down when it has to recalc and when it has to show you things on the
screen.

It also slows down if it has to try to figure out where those dotted lines have
to go (after you delete (or even insert) rows/columns.

(Yeah, I could have included that with the first post. Sorry!)

--

Dave Peterson
ec3...@msn.com

[Tom Ogilvy]

Maybe you should have tried mine. Seems simpler. (LOL).

Regards,
Tom Ogilvy

Str8goofE <str8...@aol.com> wrote in message

news:20021223105008...@mb-ch.aol.com...

[Str8goofE]

>Maybe you should have tried mine. Seems simpler. (LOL).
>
>Regards,
>Tom Ogilvy

Tom,

I gave it a try and it didn't work. It doesn't delete any duplicates. I
changed the col number and also used the correct sheet names, no dice.

[Tom Ogilvy]

There were a couple of typos - lightly tested so I can't say it gets them
all, but seemed to work:

Public Sub DeleteDuplicateRows()
'

' This macro deletes duplicate rows based on a duplicate value in
' the column specified in the statement Col =

Dim Col As Integer

Dim r As Long
Dim C As Range

Dim V As Variant
Dim Rng As Range

Dim shArray

Col = 5 ' column E - set to your column

'On Error GoTo EndMacro

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

shArray = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")

For k = UBound(shArray) To LBound(shArray) Step -1
Worksheets(shArray(k)).Activate
Debug.Print k, shArray(k)

Set Rng = ActiveSheet.UsedRange.Rows( _
ActiveSheet.UsedRange.Rows.Count)

N = 0

For r = Rng.Row To 1 Step -1
V = Cells(r, Col).Value

For l = k To LBound(shArray) Step -1

If l = k Then
If Application.WorksheetFunction.CountIf(Columns(Col), V) > 1 Then

Debug.Print Cells(r, Col).Address(external:=True)

Cells(r, Col).EntireRow.Delete
Exit For
End If
Else

If Application.CountIf(Worksheets(shArray(l)).Columns(Col), V) > 0 Then
Debug.Print shArray(l), Cells(r, Col).Address(external:=True)
Cells(r, Col).EntireRow.Delete
Exit For
End If
End If
Next l
Next r

Next k
EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Regards,
Tom Ogilvy

"Str8goofE" <str8...@aol.com> wrote in message

news:20021224105202...@mb-mu.aol.com...