CSV Help needed

[LostInNY]

I have 1 workbook with multiple worksheets and I am creating CSVs for each
worksheet. The issue is before I load the CSVs in another application, I
need to delete any duplicates and empty rows from the CSVs. I am getting
duplicates and empty rows in my CSVs because the workbook contains formulas
to populate the data in the worksheets based on certain criteria. So, some
of the rows on certain worksheets make not be populated and some may be
duplicates. Is there a way to remove the empty rows and duplicate rows
either before or after the CSVs are created that is not manual. I am using
the following to create my CSVs:


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("SHEET1", "SHEET2", "SHEET3", "SHEET4", "4X LANE",
"SHEET5", "SHEET6", "SHEET7", "SHEET8") '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

 

[KC]

If you do not mind the CSV file to be in different order,
assuming duplicate row means identical every cell in the row,
may be you can add these lines after w.Copy

Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
lrow = Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Range("A2:A" & lrow)
Rng.Sort key1:=Range("A2")
For i = lrow To 2 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then Rows(i).Delete
Next i

 

[LostInNY]

KC-

I tried your suggestion of adding the lines but it only locks the
application. Here is the code I used:


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
Dim lrow as Long
Dim Rng as Range
Dim i as Integer

myNames = = Array("SHEET1", "SHEET2", "SHEET3", "SHEET4", "4X LANE",Application.ScreenUpdating = False
Application.DisplayAlerts = False
For wCtr = LBound(myNames) To UBound(myNames)
Set w = Worksheets(myNames(wCtr))
w.Copy

Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
lrow = Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Range("A2:A" & lrow)
Rng.Sort key1:=Range("A2")
For i = lrow To 2 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then Rows(i).Delete
Next i

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path _
& "\" & w.Name, FileFormat:=xlCSV
ActiveWorkbook.Close
Next wCtr
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[KC]

locks the application ?

I cannot test the macro.
Did you step through it please?

 

[LostInNY]

KC-

It will not allow me to step through it. Any more suggestions?


Thanks