I am trying to improve below VBA I found in this thread. Would it be possible to have this code in the form of Application.Dialogs(xlDialogSaveAs).Show(Arg2:=xlCSV)
method, so I can choose where to save the CSV file?
Option Explicit
Sub CSV_Makerr()
Dim r As Range
Dim sOut As String, k As Long, M As Long
Dim N As Long, nFirstRow As Long, nLastRow As Long
Dim MyFilePath As String, MyFileName As String
Dim fs, a, mm As Long
Dim separator As String
ActiveSheet.UsedRange
Set r = ActiveSheet.UsedRange
nLastRow = r.Rows.Count r.Row - 1
nFirstRow = r.Row
separator = ","
MyFilePath = "C:\TestFolder\"
MyFileName = "whatever"
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(MyFilePath & MyFileName & ".csv", True)
For N = nFirstRow To nLastRow
k = Application.WorksheetFunction.CountA(Cells(N, 1).EntireRow)
sOut = ""
If k = 0 Then
Else
M = Cells(N, Columns.Count).End(xlToLeft).Column
For mm = 1 To M
sOut = sOut & Cells(N, mm).Text & separator
Next mm
sOut = Left(sOut, Len(sOut) - 1)
a.writeline (sOut)
End If
Next
a.Close
End Sub
The idea is to remove the commas from the CSV or blank column that is persistently exist even after I delete it several times. Above code works, but without the liberty to choose the location path for different end users or PC. Kindly let me know if it's possible.
CodePudding user response:
Something like this?
Sub CSV_Makerr()
Dim r As Range
Dim sOut As String, k As Long, M As Long
Dim N As Long, nFirstRow As Long, nLastRow As Long
Dim MyFilePath As String, MyFileName As String
Dim fs, a, mm As Long
Dim separator As String
ActiveSheet.UsedRange
Set r = ActiveSheet.UsedRange
nLastRow = r.Rows.Count r.Row - 1
nFirstRow = r.Row
separator = ","
MyFilePath = Application.GetSaveAsFilename(fileFilter:="CSV Files (*.csv), *.csv")
If MyFilePath <> "" Then
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(MyFilePath, True)
For N = nFirstRow To nLastRow
k = Application.WorksheetFunction.CountA(Cells(N, 1).EntireRow)
sOut = ""
If k = 0 Then
Else
M = Cells(N, Columns.Count).End(xlToLeft).Column
For mm = 1 To M
sOut = sOut & Cells(N, mm).Text & separator
Next mm
sOut = Left(sOut, Len(sOut) - 1)
a.writeline (sOut)
End If
Next
a.Close
End If
End Sub