How do I transpose a set of columns and save the o

Question

Closed. This question needs to be more focused. It is not currently accepting answers.

---

Want to improve this question? Update the question so it focuses on one problem only by editing this post.

Closed 4 years ago.

I have a long set of information in columns, sometimes hundreds of rows (This is being generated via VBA). I need to transpose this AND save it as a CSV (as excel would run out of columns).

A screenshot of the table is attached.

Any help is appreciated in advance.

Question has been answered in two different ways. Am sure it will be valuable to many other people.

Answer 1

You take some code to export to CSV, such as from this answer How to create a separate CSV file from VBA? and just change the order you write to the file. E.g. write the column before writing the row

Sub WriteFile()

  Dim ColNum As Integer
  Dim Line As String
  Dim LineValues() As Variant
  Dim OutputFileNum As Integer
  Dim PathName As String
  Dim RowNum As Integer
  Dim SheetValues() As Variant

  PathName = Application.ActiveWorkbook.Path
  OutputFileNum = FreeFile

  Open PathName & "\Test.csv" For Output Lock Write As #OutputFileNum

  'Print #OutputFileNum, "Field1" & "," & "Field2"

  SheetValues = Sheets("RawData").Range("A1:C249").Value

Dim RowMax
RowMax = UBound(SheetValues)
Dim ColMax
ColMax = 3
ReDim LineValues(1 To RowMax)

  For ColNum = 1 To ColMax
    For RowNum = 1 To RowMax
      LineValues(RowNum) = SheetValues(RowNum, ColNum)
    Next
    Line = Join(LineValues, ",")
    Print #OutputFileNum, Line
  Next

  Close OutputFileNum

End Sub

Hopefully that is a good enough to get you going.

Answer 2

Here is a shorter version (I used Nats code as a basis). It should be a lot faster as it does away with looping the rows.

Sub WriteFile()
Dim LR As Long, ColNum As Long, PathName As String, OutputFileNum As String
PathName = Application.ActiveWorkbook.Path
OutputFileNum = FreeFile
Open PathName & "\Test.csv" For Output Lock Write As #OutputFileNum
For ColNum = 1 To Cells(1, Columns.Count).End(xlToLeft).column
    LR = Cells(1, ColNum).Offset(Rows.Count - 1, 0).End(xlUp).Row
    CSVString = Join(Application.Transpose(Cells(1, ColNum).Resize(LR, 1)), ",")
    Print #OutputFileNum, CSVString
Next
Close OutputFileNum
End Sub