Skip to content

Instantly share code, notes, and snippets.

@stevehenderson
Last active December 17, 2015 08:39
Show Gist options
  • Save stevehenderson/5581444 to your computer and use it in GitHub Desktop.
Save stevehenderson/5581444 to your computer and use it in GitHub Desktop.
VBA code to write worksheet calues to a CSV
Function writeCSV(csvPath As String) As String
'Create a CSV
Dim i As Integer
Dim lastUsedColumn As Integer
Dim done As Boolean
lastUsedColumn = 9
i = 1
done = False
While Not done
If Worksheets("MAIN").Cells(16, i + 1) = "(SELECT SE MAJOR)" Then
done = True
Else
i = i + 1
lastUsedColumn = i
End If
Wend
If i = 1 Then
MsgBox ("You did not select any cadets. Please try again")
writeCSV = "Error"
Else
Dim wSht1 As Worksheet
Set wSht1 = Worksheets("MAIN")
Worksheets("MAIN").Range(Cells(16, 2), Cells(47, lastUsedColumn)).Select
Selection.Copy
Workbooks.Add
Dim wSht2 As Worksheet
Set wSht2 = ActiveSheet
With wSht2
.Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End With
'Write the headers
wSht2.Range("A1") = "SECADET"
For i = 1 To 31
wSht2.Cells(1, i + 1) = Left(wSht1.Cells(16 + i, 1), 6)
Next i
'Get the return string
Dim lastRow As Integer
wSht2.Range("A1").Select
Selection.End(xlDown).Select
lastRow = ActiveCell.Row
Dim x As Integer
Dim y As Integer
Dim result As String
For y = 1 To lastRow
For x = 1 To 31
result = result & wSht2.Cells(y, x) & ","
Next x
result = result & vbCrLf
Next y
writeCSV = result
'ActiveSheet.Paste
'ActiveSheet.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
' False, Transpose:=True
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=csvPath, FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True
End If
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment