visualnotsobasic
New Member
- Joined
- Mar 12, 2021
- Messages
- 3
- Office Version
- 365
- Platform
- Windows
Hey Everyone,
I'm new to to VBA and I'm having trouble with one part of my code. I managed to get most of the pieces to work, but I cannot figure out this last piece at all. The basic idea is to have a template worksheet with formulas that will pull data in from a specific folder and then save that into another .xlsx workbook and a .csv (all of this works so far). The problem that I'm running into is that when it saves into a .csv format, I need to have all the blank rows deleted as well as the header so I can drop it into another folder for upload. The blank rows will not delete unfortunately. It was working at some point but then I made some tweaks to the code and I cannot figure out what I did. I've posted the part of the code that I'm having most trouble with.
I would appreciate any and all help!
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Dim LastRowIndex As Integer
Dim RowIndex As Integer
Dim UsedRng As Range
Set CurrentWB = ActiveWorkbook
Set UsedRng = ActiveSheet.UsedRange
ActiveWorkbook.ActiveSheet.UsedRange.Copy
LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
Application.ScreenUpdating = False
Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
'Delete blank rows in CSV'
Dim i As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
Rows([1]).EntireRow.Delete
'Save CSV'
MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=True
Application.DisplayAlerts = True
End With
I'm new to to VBA and I'm having trouble with one part of my code. I managed to get most of the pieces to work, but I cannot figure out this last piece at all. The basic idea is to have a template worksheet with formulas that will pull data in from a specific folder and then save that into another .xlsx workbook and a .csv (all of this works so far). The problem that I'm running into is that when it saves into a .csv format, I need to have all the blank rows deleted as well as the header so I can drop it into another folder for upload. The blank rows will not delete unfortunately. It was working at some point but then I made some tweaks to the code and I cannot figure out what I did. I've posted the part of the code that I'm having most trouble with.
I would appreciate any and all help!
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Dim LastRowIndex As Integer
Dim RowIndex As Integer
Dim UsedRng As Range
Set CurrentWB = ActiveWorkbook
Set UsedRng = ActiveSheet.UsedRange
ActiveWorkbook.ActiveSheet.UsedRange.Copy
LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
Application.ScreenUpdating = False
Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
'Delete blank rows in CSV'
Dim i As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
Rows([1]).EntireRow.Delete
'Save CSV'
MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=True
Application.DisplayAlerts = True
End With