Alex O
06-11-2013, 08:12 AM
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.
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
Any thoughts and/or suggestions would be appreciated.
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