PDA

View Full Version : Solved: Alter code for macro to all worksheets for duplicates



BENSON
02-07-2008, 09:19 PM
The code below ( Which i found in this forum ) checkes for and deletes duplicates .It works fine but I see it will only work on the active worksheet.Could some one help me with code so when activated it will check all the worksheets 7 in total .
Thanks


Option Explicit

Sub DeleteDups()

Dim x As Long
Dim LastRow As Long

LastRow = Range("b65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("b1:b" & x), Range("b" & x).Value) > 1 Then
Range("b" & x).EntireRow.Delete
End If
Next x

End Sub

stanleydgrom
02-07-2008, 10:09 PM
BENSON,

Try this.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).




Option Explicit
Sub DeleteDups()
Dim wSheet As Worksheet
Dim x As Long
Dim LastRow As Long
Application.ScreenUpdating = False
Sheets(1).Select
For Each wSheet In Worksheets
wSheet.Select
LastRow = Range("B" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("b1:b" & x), Range("b" & x).Value) > 1 Then
Range("b" & x).EntireRow.Delete
End If
Next x
Next wSheet
Application.ScreenUpdating = True
End Sub




Have a great day,
Stan

BENSON
02-07-2008, 10:34 PM
THANKS WORKS GREAT