Code Fix to Delete Duplicates

[Alex O]

I'm in the process of putting the below code together to essentially create a new text file>delete duplicates>attach to email and send to client. Everything seems to functioning correctly except the DeleteDups procedure is not deleting the duplicates! It's strange because the code is executing and seems to be performing as intended, except it doesn't delete anything!

Any thoughts and/or suggestions would be appreciated.

[VBA]Sub
CopytoNewWorkbook()
Workbooks.Add
ThisWorkbook.Worksheets(2).Range("A6:P200").Copy
Range("A6").PasteSpecial
Paste:=xlPasteValues
Range("A6").PasteSpecial
Paste:=xlPasteFormats
Columns.AutoFit
End Sub
Sub DeleteDups()
Dim
x
As Long
Dim LastRow As
Long
LastRow = Range("B200").End(xlUp).Row
For x = LastRow To 1 Step
-1
If Application.WorksheetFunction.CountIf(Range("B7:B" & x), Range("B"
& x).Text) > 1 Then
Range("B" & x).EntireRow.Delete
End
If
Next x
End Sub
Sub MailSheet()
Dim shtName As String
shtName =
ActiveSheet.Name
ActiveSheet.Copy
ActiveWorkbook.SaveAs "List
" & Format(Date, "mm-dd-yyyy") & ".xls"
Application.DisplayAlerts =
False
Application.Dialogs(xlDialogSendMail).Show
With
ActiveWorkbook
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close
False
End With
Application.DisplayAlerts = True
End Sub[/VBA]

[SamT]

The only problem I can see with your code without running it is that "For x = LastRow To 1" should read "For x = LastRow To 7."

Anyway, try this version.

[VBA]Option Explicit

Sub DeleteDups()
Dim c As Long
Dim MyRange As Range

Set MyRange = Range("B7:B" & CStr(Cells(Rows.Count, 2).End(xlUp).Row))

For c = MyRange.Cells.Count To 1 Step -1
If Application.WorksheetFunction.CountIf(MyRange, _
MyRange.Cells(c).Value) > 1 Then _
MyRange.Cells(c).EntireRow.Delete
Next c

End Sub[/VBA]

[Alex O]

Worked perfectly....thanks!

Alex