(Excel) How to extract each column (and save it) as its own CSV file?

Question

Is it possible to save each column in a worksheet as its own CSV file? That's the main thing I'm trying to accomplish, though there are more details.

EDIT: Code almost works, except for some reason it seems to be only looping for two of the ~30 worksheets. It outputs anywhere from 125-135 csv files (not sure why it varies?), however it should be outputting closer to ~1000 csv files.

Any idea on why the code isn't looping across all sheets? (Code at bottom + updated workbook)

All of the other solutions I found involve python or other scripting languages, I couldn't find anything specific for automating extracting a column from an excel worksheet and saving it as a separate CSV.

Goal:
(Across all worksheets, except "AA" and "Word Frequency")
To save each column (starting at column E) as its own CSV file

Purpose:
To create individual data CSV files for further processing by another program. (This program needs the data organized this way)

Conditions / Constraints:

1. Number of columns will vary for each worksheet. First column will always be column E

2. Number each individual CSV (1.csv, 2.csv, 3.csv…. 9999.csv), and save in the working folder of the excel file. Iterate the number (+1) so no other CSV’s are overwritten

3. Format new CSV file such that the first row (header) is left as is, and the rest of the cells (below the header) are enclosed with quotation marks, and pasted into the first cell in the 2nd column

Resources:
Link to worksheet
Link to updated workbook
Link to 3.csv (Sample output CSV)

Visual Examples:

View of how Worksheet Data is organized

How I'm trying to have the CSV files saved (numerical iteration, so it will be easy for other program to load all CSV files with loop)

Example of how each CSV file contents will look like - (Cell A1 is the "Header" value, and Cell B1 is all of the keywords (that existed below the header in the master excel sheet) bunched into one cell, contained by quotation marks "")

Code that is almost working, however only loops for 2 worksheets instead of all worksheets besides "AA" and "Word Frequency":
Newest workbook I'm working with

Option Explicit

Public counter As Integer


Sub Create_CSVs_AllSheets()

    Dim sht 'just a tmp var

    counter = 1                 'this counter will provide the unique number for our 1.csv, 2.csv.... 999.csv, etc
    appTGGL bTGGL:=False
    For Each sht In Worksheets  ' for each sheet inside the worksheets of the workbook
        If sht.Name <> "AA" And sht.Name <> "Word Frequency" Then
        'IF sht.name is different to AA AND sht.name is diffent to WordFrecuency THEN

        'TIP:
        'If Not sht.Name = noSht01 And Not sht.Name = noSht02 Then 'This equal
        'IF (NOT => negate the sentence) sht.name is NOT equal to noSht01 AND
        '                                sht.name is NOT equal to noSht02 THEN

            sht.Activate 'go to that Sheet!
            Create_CSVs_v3 (counter) 'run the code, and pass the counter variable (for naming the .csv's)


        End If '
    Next sht 'next one please!
    appTGGL
End Sub

Sub Create_CSVs_v3(counter As Integer)
Dim ws As Worksheet, i As Integer, j As Integer, k As Integer, sHead As String, sText As String
Set ws = ActiveSheet    'the sheet with the data, _
                        'and we take the name of that sheet to do the job

For j = 5 To ws.Cells(1, Columns.Count).End(xlToLeft).Column
     If ws.Cells(1, j) <> "" And ws.Cells(2, j) <> "" Then
          sHead = ws.Cells(1, j)
          sText = ws.Cells(2, j)
          If ws.Cells(rows.Count, j).End(xlUp).Row > 2 Then
               For i = 3 To ws.Cells(rows.Count, j).End(xlUp).Row   'i=3 because above we defined that_
                                                                    'sText = ws.Cells(2, j) above_
                                                                    'Note the "2" above and the sText below
                    sText = sText & Chr(10) & ws.Cells(i, j)
                    Next i
               End If
          Workbooks.Add
          ActiveSheet.Range("A1") = sHead
          'ActiveSheet.Range("B1") = Chr(34) & sText & Chr(34)
          ActiveSheet.Range("B1") = Chr(10) & sText 'Modified above line to start with "Return" character (Chr(10))
          'instead of enclosing with quotation marks (Chr(34))

          ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & counter & ".csv", _
          FileFormat:=xlCSV, CreateBackup:=False 'counter variable will provide unique number to each .csv

          ActiveWorkbook.Close SaveChanges:=True
          'Application.Wait (Now + TimeValue("0:00:01"))
          counter = counter + 1                 'increment counter by 1, to make sure every .csv has a unique number
          End If
     Next j

Set ws = Nothing
End Sub

Public Sub appTGGL(Optional bTGGL As Boolean = True)
    Debug.Print Timer
    Application.ScreenUpdating = bTGGL
    Application.EnableEvents = bTGGL
    Application.DisplayAlerts = bTGGL
    Application.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
End Sub

Any idea on what is wrong with the latest code?
Any help would be greatly appreciated.

sikorloa · Accepted Answer

With help from @Elbert Villarreal I was able to get the code to work.

The last (almost working) code I had in the example was (almost) right, Elbert pointed out that:

Within Create_CSVs_AllSheets() subroutine:
I needed to pass sht.Index to the Create_CSVs_v3()subroutine to get Create_CSVs_v3() to run across all sheets.
Passing the counter variable was incorrect since it's a Public (global) variable. If it's changed within any subroutine, the new value will stick for wherever else the variable is called.

Within Create_CSVs_v3() subroutine:
Needed to Set ws = Sheets(shtIndex) in order to set it to the exact sheet, not just the one which is active.

Working Code:

Option Explicit

Public counter As Integer

Sub Create_CSVs_AllSheets()

    Dim sht As Worksheet        '[????????????????]just a tmp var[????????????????]

    counter = 1                 'this counter will provide the unique number for our 1.csv, 2.csv.... 999.csv, etc                         

    appTGGL bTGGL:=False

    For Each sht In Worksheets  ' for each sheet inside the worksheets of the workbook

        If sht.Name <> "AA" And sht.Name <> "Word Frequency" Then


        'IF sht.name is different to AA AND sht.name is diffent to WordFrecuency THEN

        'TIP:

        'If Not sht.Name = noSht01 And Not sht.Name = noSht02 Then 'This equal

        'IF (NOT => negate the sentence) sht.name is NOT equal to noSht01 AND

        '                                sht.name is NOT equal to noSht02 THEN

        sht.Activate 'go to that Sheet!

        Create_CSVs_v3 sht.Index 'run the code, and pass the counter variable (NOT for naming the .csv's)

                                 'Run the code, and pass the sheet.INDEX of the current sheet to select that sheet

                                 'you will affect the counter inside Create_CSVs_v3

        End If '

    Next sht 'next one please!

    appTGGL

End Sub



Sub Create_CSVs_v3(shtIndex As Integer)

    Dim ws As Worksheet

    Dim i As Integer

    Dim j As Integer

    Dim k As Integer

    Dim sHead As String

    Dim sText As String



    Dim maxCol As Long

    Dim maxRow As Long

    Set ws = Sheets(shtIndex)    'Set the exact sheet, not just which one is active.

                                 'and then you will go over all the sheets

    'NOT NOT Set ws = ActiveSheet    'the sheet with the data, _

                            'and we take the name of that sheet to do the job



    maxCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column

    For j = 5 To maxCol

        If ws.Cells(1, j) <> "" And ws.Cells(2, j) <> "" Then 'this IF is innecesary if you use

                                                               'ws.Cells(1, Columns.Count).End(xlToLeft).Column

                                                               'you'r using a double check over something that you check it

            sHead = ws.Cells(1, j)

            sText = ws.Cells(2, j)



            If ws.Cells(rows.Count, j).End(xlUp).Row > 2 Then

                maxRow = ws.Cells(rows.Count, j).End(xlUp).Row 'Use vars, instead put the whole expression inside the

                                                               'for loop



                For i = 3 To maxRow   'i=3 because above we defined that_

                                      'sText = ws.Cells(2, j) above_

                                      'Note the "2" above and the sText below

                     sText = sText & Chr(10) & ws.Cells(i, j)

                Next i

            End If

            Workbooks.Add

            ActiveSheet.Range("A1") = sHead

            'ActiveSheet.Range("B1") = Chr(34) & sText & Chr(34)

            ActiveSheet.Range("B1") = Chr(10) & sText 'Modified above line to start with "Return" character (Chr(10))

                                                      'instead of enclosing with quotation marks (Chr(34))



            ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & counter & ".csv", _
            FileFormat:=xlCSV, CreateBackup:=False 'counter variable will provide unique number to each .csv



            ActiveWorkbook.Close SaveChanges:=True

                                                  'Application.Wait (Now + TimeValue("0:00:01"))

            counter = counter + 1                 'increment counter by 1, to make sure every .csv has a unique number

        End If

    Next j

    Set ws = Nothing

End Sub



Public Sub appTGGL(Optional bTGGL As Boolean = True)

    Debug.Print Timer

    Application.ScreenUpdating = bTGGL

    Application.EnableEvents = bTGGL

    Application.DisplayAlerts = bTGGL

    Application.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)

End Sub

(Excel) How to extract each column (and save it) as its own CSV file?

Answers (2)

Related Questions