Deleting duplicate rows when creating a CSV automatically

[LostInNY]

I need help with deleting duplicate rows of data in columns 1-7 of a new CSV
file that is created. I have a macro setup to automatically create a CSV
when the workbook is saved. When the CSVs are created I need to delete the
rows that are duplicate also.

 

[Otto Moehrbach]

What constitutes a duplicate row? If 2 rows have the same entry in Column
A, does that mean they are duplicates or do you have to look at all 7
columns in each row? HTH Otto

 

[LostInNY]

Otto-

All seven columns must have the same data in order to be a duplicate.

 

[LostInNY]

Otto-
To create the CSVs I am using the following and would like to delete the
duplicate rows when creating the CSV files:

Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim wCtr As Long
Dim w As Worksheet
Dim myNames As Variant

myNames = Array("1RATE OFFERING", "RATE OFFERING STOPS DEFAULT",
"3RATE_OFFERING_ACCESSORIAL", "2A-ACCESSORIAL_CODE", "4X LANE", "5RATE GEO",
"6RATE GEO COST GROUP", "7RATE GEO COST", "9RATE GEO ACCESSORIAL") 'add more
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For wCtr = LBound(myNames) To UBound(myNames)
Set w = Worksheets(myNames(wCtr))
w.Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path _
& "\" & w.Name, FileFormat:=xlCSV
ActiveWorkbook.Close
Next wCtr
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[Otto Moehrbach]

Lost
Here is stand-alone macro that does what you want. Place a call to this
macro within your code. HTH Otto
Sub DelDupRows()
Dim rColA As Range, i As Range, FoundA As Range, rRow As Range
Dim c As Long, cc As Long, RowsMatch As Boolean
Application.ScreenUpdating = False
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp))
For c = rColA.Count To 1 Step -1
Set FoundA = rColA.Find(What:=rColA(c), After:=rColA(c),
LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns,
SearchDirection:=xlNext, _
MatchCase:=False)
If FoundA.Row <> rColA(c).Row Then
Set rRow = rColA(c).Resize(, 7)
cc = 0
RowsMatch = True
For Each i In rRow
If i.Value <> FoundA.Offset(, cc).Value Then
RowsMatch = False
Exit For
End If
cc = cc + 1
Next i
If RowsMatch = True Then rColA(c).EntireRow.Delete
End If
Next c
Application.ScreenUpdating = True
End Sub