Forum Discussion

Iron Contributor

Apr 17, 2020

Solved

Modify macro for CSV

I have this code, it will create one .csv file with header and row for each row in a table. I copies from another place and did some minor modifications, now what I need is to add a way so the macro...

Macros and VBA

Riny_van_Eekelen

Apr 21, 2020

Ocasio27

Adjusted your code a little bit. You need to include your variables "sWorkbookPath" and "fName" in the code that saves the workbook. But before that, you must pick-up the file name within the loop, so that it starts with A2, then A3, then A4 etc.

See if you can get it to work. If not, come back!

Sub SaveCSVfiles()
    Dim last_row As Long
    last_row = Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
    Dim sWorkbookPath As String
    Dim fName As String

    sWorkbookPath = ActiveWorkbook.Path
    MsgBox "Active Workbook Path is : " & sWorkbookPath, vbInformation, "VBAF1"
    Const NumRows As Integer = 1
    Const HeaderRow As Integer = 1
    
    Dim iRow As Integer, startSheet As Worksheet, tmpSheet As Worksheet
    
    Application.ScreenUpdating = False

    iRow = HeaderRow + 1
    Set startSheet = ActiveSheet
    Do Until iRow > last_row + HeaderRow
        Set tmpSheet = Worksheets.Add
        
        fName = startSheet.Range("A" & iRow)
        
        'copy the header
        startSheet.Range(HeaderRow & ":" & HeaderRow).EntireRow.Copy tmpSheet.Range("A1")
        'copy the data
        startSheet.Range(iRow & ":" & (iRow + NumRows - HeaderRow)).EntireRow.Copy tmpSheet.Range("A2")
        'save tmpSheet to CSV file
        tmpSheet.Move
        With ActiveWorkbook
            .SaveAs Filename:=sWorkbookPath & fName & (iRow + NumRows - HeaderRow - 1) & ".csv", FileFormat:=xlCSVMSDOS
            .Close True
        End With
        iRow = iRow + NumRows
    Loop
    
    Application.ScreenUpdating = True
    
End Sub

Riny_van_Eekelen

Platinum Contributor

Apr 18, 2020

Ocasio27

To include 4th column header in the file name you need to declare a variable first. For example:

Dim fName as String

Then you have to read out the value of the header and assign it to the fName. This could be something like this:

fName = Range("D1")

Then you insert fName into the code where the file is being saved. For instance:

.SaveAs Filename:=FolderPath & fName & etc.....

Change the folder path to where you want to save the CSV file or leave it out if you want to save it into your current active folder, i.e. the folder from which you opened your workbook. That should work, I believe.

Now, having said all of this, I have not been able to test any of it, since I don't have your file. Try tweaking the code along these lines and just test it yourself.

Ocasio27

Iron Contributor

Apr 21, 2020

Riny_van_Eekelen

This is a modified version of the file to protect sensitive information. The name of each file should be A column. I am trying but it keeps trowing all the files in document folder and also it names all files with number, 1,2,3,4.....

CSV Generator.xlsm23 KB

Riny_van_Eekelen

Platinum Contributor

Apr 21, 2020

Ocasio27

See if you can get it to work. If not, come back!

Sub SaveCSVfiles()
    Dim last_row As Long
    last_row = Cells.Find(What:="*", SearchDirection:=xlPrevious).Row
    Dim sWorkbookPath As String
    Dim fName As String

    sWorkbookPath = ActiveWorkbook.Path
    MsgBox "Active Workbook Path is : " & sWorkbookPath, vbInformation, "VBAF1"
    Const NumRows As Integer = 1
    Const HeaderRow As Integer = 1
    
    Dim iRow As Integer, startSheet As Worksheet, tmpSheet As Worksheet
    
    Application.ScreenUpdating = False

    iRow = HeaderRow + 1
    Set startSheet = ActiveSheet
    Do Until iRow > last_row + HeaderRow
        Set tmpSheet = Worksheets.Add
        
        fName = startSheet.Range("A" & iRow)
        
        'copy the header
        startSheet.Range(HeaderRow & ":" & HeaderRow).EntireRow.Copy tmpSheet.Range("A1")
        'copy the data
        startSheet.Range(iRow & ":" & (iRow + NumRows - HeaderRow)).EntireRow.Copy tmpSheet.Range("A2")
        'save tmpSheet to CSV file
        tmpSheet.Move
        With ActiveWorkbook
            .SaveAs Filename:=sWorkbookPath & fName & (iRow + NumRows - HeaderRow - 1) & ".csv", FileFormat:=xlCSVMSDOS
            .Close True
        End With
        iRow = iRow + NumRows
    Loop
    
    Application.ScreenUpdating = True
    
End Sub

Ocasio27
Iron Contributor
Apr 21, 2020
Riny_van_Eekelen

Its working perfectly except that for some strange reason it is generating the .csv files one folder up.
Example
/firstF/SecondF = Location of .xlsm
/firstf/ = Location is placing the .csv files

This might be useful someday, but for now, how can i fix this.