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",
> > "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
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" wrote:
> 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" <(E-Mail Removed)> wrote in message
> news:1E4C933F-BA54-43DE-B12D-(E-Mail Removed)...
> >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
>
>
>
|
Similar Threads
