If you want to remove all duplicates then the condition should be

intCounter 0 rather than
intCounter 1

Also, you are checking each worksheet against itself, so your script will
remove all values on all sheets. You need to increment the counter within
an If statement like this:

If ws2.Name < ws.Name Then
intCounter = intCounter + xTest
End If

I ran the macro with these changes and it works as I believe you want it to.
(Revised macro below)

HTH,
Shockley


Sub Tester()
For Each ws In ActiveWorkbook.Sheets
ws.Activate
If Selection.Rows.Count 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If

For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, 1).Value
intCounter = 0

For Each ws2 In ActiveWorkbook.Sheets
If ws2.Name < ws.Name Then _
intCounter = intCounter + _
Application.WorksheetFunction. _
CountIf(ws2.Columns(1), V)

Next ws2

If intCounter 0 Then
Rng.Rows(r).EntireRow.Delete
N = N + 1
End If

Next r

Next ws
End Sub




"jimmy" wrote in message
...
are you serious....great i dont know whats going on, i
copy and pasted that code from the script i have, and it
worked for you? when i step into it, it goes through
twice, like it should, the intCounter is at 15,000
something like it should be. but after it runs through
the loop twice, it exits out of everything...any
clue...here is my entire script, its supposed to delete
duplicate entries across multiple sheets. jouni helped me
write the tough parts...thanks again..

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

Dim ws As Worksheet, ws2 As Worksheet
Dim intCounter As Integer

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

Col = ActiveCell.Column

N = 0

For Each ws In ActiveWorkbook.Sheets
ws.Activate
If Selection.Rows.Count 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If


For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, 1).Value

intCounter = 0

For Each ws2 In ActiveWorkbook.Sheets

intCounter = intCounter +
Application.WorksheetFunction.CountIf(ws2.Columns( 1), V)

Next ws2

If intCounter 1 Then
Rng.Rows(r).EntireRow.Delete
N = N + 1
End If

Next r


Next ws

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

-----Original Message-----
It runs the If statement for me. Sounds
like "intCounter" is not getting
1 for you.

HTH, Shockley



"jimmy" wrote in message
...
I have the following piece of code that contains 1 for
loop with two imbedded for loops in it. The problem i
am
having is that the deepest for loop (ws2) when finishing
breaks out of both outer for loops (r, ws) and exits to
the end. I am not understanding why. the program
doesnt
even run through to the if statement (intCounter), just
breaks when for loop (ws2) completes. Any
suggestions....

For Each ws In ActiveWorkbook.Sheets
ws.Activate
If Selection.Rows.Count 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If


For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, 1).Value
intCounter = 0

For Each ws2 In ActiveWorkbook.Sheets
intCounter = intCounter +
Application.WorksheetFunction.CountIf(ws2.Columns( 1), V)
Next ws2

If intCounter 1 Then
Rng.Rows(r).EntireRow.Delete
N = N + 1
End If

Next r


Next ws


.