Specify Columns to Write File to CSV

[paynod]

I have the following code which writes a worksheet to csv and puts it in its required folder.

How can I adapt my code to only write the first 8 columns of the worksheet to CSV?



Sub csv()
Dim fs As Object, a As Object, i As Integer, s As String, t As String, l As String, mn As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("S:\test\plan.csv", True)

For r = 1 To Range("a5000").End(xlUp).Row
s = ""
c = 1
While Not IsEmpty(Cells(r, c))
s = s & Cells(r, c) & ","
c = c + 1
Wend
a.writeline s 'write line
Next rEnd If
End Sub

[Kenneth Hobs]

I could show you how to use your background method if you like.

Here is my foreground method.

Sub test_ExportRangetoCSV()
ExportRangeToCSV Range("A1:H1").CurrentRegion, "S:\test\plan.csv"
End Sub


Sub ExportRangeToCSV(aRange As Range, aFile As String)
Dim wb As Workbook
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set wb = Workbooks.Add
aRange.Copy wb.Worksheets(1).Range("A1")
wb.SaveAs aFile, FileFormat:=xlCSV, CreateBackup:=False
ActiveWindow.Close

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

[snb]

@KH

I'd prefer ;)


Range("A1").CurrentRegion.resize(,8)

[Paul_Hossler]

Tweaking the OP's approach (not tested), but Ken's and snb's would be faster




Option Explicit
Sub csv()
Dim fs As Object, a As Object, i As Integer, s As String, t As String, l As String, mn As String

Dim LastRow As Long, r As Long, c As Long

Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("S:\test\plan.csv", True)

LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row


For r = 1 To LastRow
s = vbNullString
For c = 1 To 8
s = ActiveSheet.Cells(r, 1).Value & ","
Next c

'get rid of last comma
s = Left(s, Len(s) - 1)

a.writeline s 'write line
Next
a.Close

End Sub

[Kenneth Hobs]

The trouble with one making their own delimited strings is how do you handle a value that has a comma in it?

Here is a modification of yours and Paul's routine.

Sub Paul()
Dim fs As Object, a As Object, i As Integer, s As String
Dim LastRow As Long, r As Long, fn As String

fn = "c:\t\plan.csv"

Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(fn, True)

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

For r = 1 To LastRow
s = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose( _
Range("A" & r, Cells(r, 9)).Value)), ",")
a.writeline s 'write line
Next

a.Close
Workbooks.Open fn
End Sub

[Paul_Hossler]

The trouble with one making their own delimited strings is how do you handle a value that has a comma in it?

Kill joy :doh:

I forgot about that issue; same for embedded quotes

My 'CSV-writer' sub is in module that I load when I need, and it has all those type of checks in already

We've actually moved towards tab separated just for things like that

[snb]

Sub M_snb()
sn=sheet1.cells(1).currentregion.resize(,8)

for j=1 to ubound(sn)
c00=c00 & vblf & join(application.index(sn,j),",")
next

createobject("scripting.fileystemobject).CreateTextFile("S:\test\plan.csv").write mid(c00,2)
end sub

[Kenneth Hobs]

Right Paul, I like quote delimited tab separated format too.

Of course we can easily do the tab deal by a similar SaveAs method by just changing fileformat to xlText. These fileformat methods take care of the embedded quotes issues as well.