Automate CSV creation with unique file names

[snuffnchess]

Attached is a small sample of data that I am trying to create individual CSV files with.

The Sheet "Sample Data" has 3 columns..... of which I have been doing a copy paste (row by row) of columns B and C into the file "sample template" A16 and B16... then doing a copy/paste values of A1:Z12 into a new file, and saving that file as a csv with a title of whatever the value in "Sample Template A16" is. See attached 10001.csv for sample output

Because eventually this will need to happen for over 200 different items, it is going to be a long and slow process to do it manually, and I was trying to find a way to automate it.

Is there a Macro that I can use to do this same thing? Sample Data and Sample Template do not necessarily need to be separate files if that makes what Im trying to do easier? Thank you in advance for your help

[Tinbendr]

Add a module and paste in this code.

Sub ParseDataFile()
Dim WB As Workbook
Dim WS As Worksheet
Dim WS2 As Worksheet
Dim A As Long
Dim B As Long
Dim LastRow As Long
Dim fileToOpen As Variant
Dim FF As Integer
Dim MyPath As String

fileToOpen = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", , "Select Data File", , False)
If fileToOpen <> False Then
    Debug.Print fileToOpen
    Set WS2 = ActiveSheet
    Workbooks.Open Filename:=fileToOpen
    Set WB = ActiveWorkbook
    Set WS = WB.Worksheets(1)
 
 With WS
     LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
     
     For A = 2 To LastRow
        For B = 2 To 12
            WS2.Range("A" & B) = .Range("C" & A)
            WS2.Range("B" & B) = .Range("C" & A)
            WS2.Range("N" & B) = .Range("B" & A) & "-" & Right("0" & B - 1, 2)
        Next
        MyPath = Left(FN, InStrRev(FN, "\"))
        FF = FreeFile
        Open MyPath & WS.Range("B" & A) & ".csv" For Output As #FF
            For i = 1 To 11
                For j = 1 To 26
                    Print #FF, WS2.Cells(i, j) & ",";
                Next
                    Print #FF, WS2.Cells(12, 27)
            Next
        Close #FF
     Next
 End With
 
WB.Close False
End If

End Sub

[snuffnchess]

To which file do I add this module to??? Does it matter?

[snuffnchess]

Sorry... stupid question... I tried it out and it is ALMMMMMOOOSSSSTTTT there.

In the original Template file I am using a concatenate naming convention on the items in Column A to add in the 00-01 pcf, 01-02 pcf, etc....

The VB code is not utilizing that part of it, so the names for column A do not come out correct.... is there a way to fix that part of it???

[jindon]

Try

Sub test()
    Dim a, i As Long, ws As Worksheet
    Application.ScreenUpdating = False
    a = Workbooks("sample data.xlsx").Sheets("sheet1").Cells(1).CurrentRegion.Value
    Set ws = ThisWorkbook.Sheets.Add
    ThisWorkbook.Sheets("commodity_template (3)").Cells(1).CurrentRegion.Copy
    ws.Cells(1).PasteSpecial xlPasteValues
    ws.Columns("a:b").Replace a(2, 3), Chr(2), 2
    ws.Columns("n").Replace a(2, 2), Chr(2), 2
    For i = 2 To UBound(a, 1)
        ws.Columns("a:b").Replace Chr(2), a(i, 3), 2
        ws.Columns("n").Replace Chr(2), a(i, 2), 2
        ws.Copy
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & a(i, 2) & ".csv", xlCSV
        ActiveWorkbook.Close False
        ws.Columns("a:b").Replace a(i, 3), Chr(2), 2
        ws.Columns("n").Replace a(i, 2), Chr(2), 2
    Next
    Application.DisplayAlerts = False
    ws.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

[Tinbendr]

I just assumed that the sample data would be changing and so was trying to prevent chaving to edit the template sheet. But as usual, I was thinking too much,

Here's the adjusted code.

Sub ParseDataFile()
Dim WB As Workbook
Dim WS As Worksheet
Dim WS2 As Worksheet
Dim A As Long
Dim B As Long
Dim LastRow As Long
Dim fileToOpen As Variant
Dim FF As Integer
Dim MyPath As String

fileToOpen = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", , "Select Data File", , False)
If fileToOpen <> False Then
    Debug.Print fileToOpen
    Set WS2 = ActiveSheet
    Workbooks.Open Filename:=fileToOpen
    Set WB = ActiveWorkbook
    Set WS = WB.Worksheets(1)
 
     With WS
         LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
         For A = 2 To LastRow
         WS2.Range("b16") = .Range("C" & A)
            For B = 2 To 12
                
                WS2.Range("B" & B) = .Range("C" & A)
                WS2.Range("N" & B) = .Range("B" & A) & "-" & Right("0" & B - 1, 2)
            Next
            MyPath = Left(FN, InStrRev(FN, "\"))
            FF = FreeFile
            Open MyPath & WS.Range("B" & A) & ".csv" For Output As #FF
                For i = 1 To 11
                    For j = 1 To 26
                        Print #FF, WS2.Cells(i, j) & ",";
                    Next
                        Print #FF, WS2.Cells(12, 27)
                Next
            Close #FF
         Next
     End With
     
    WB.Close False
End If

End Sub

[snuffnchess]

Thank you so very much! One of the ways that I learn is by looking at code and trying to figure it out... how to change it, and what the changes will do. This has helped me understand a lot more on the VB side.

One question that I have is, if the initial sample data size were to grow to say 100 lines, 1000 lines, etc Is the change that would need to occur be in the

For j = 1 To 26

part? And just update that 26 to however many rows there are without the header row included???

[Tinbendr]

Here is an updated file that moved the B16 to A1 for dynamic template.

Sub ParseDataFile()
Dim WB As Workbook
Dim WS As Worksheet
Dim WS2 As Worksheet
Dim A As Long
Dim B As Long
Dim LastRow As Long
Dim LR As Long
Dim fileToOpen As Variant
Dim FF As Integer
Dim MyPath As String
Dim Desc As String
Dim I As Long, J As Long

'Navigate for Sample data file.
fileToOpen = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", , "Select Data File", , False)
'Test that Cancel wasn't clicked
If fileToOpen <> False Then
    'Create ojbect of template
    Set WS2 = ActiveSheet
    'Get the lastrow of template data in column A
    With WS2
        LR = .Cells(Rows.Count, "A").End(xlUp).Row
    End With
    'Open the Sample data workbook
    Workbooks.Open Filename:=fileToOpen
    'Create object of sample data file.
    Set WB = ActiveWorkbook
    'Assign Sample data file worksheet to an object.
    Set WS = WB.Worksheets(1)
    
     With WS
         'Determine lastrow of sampole file sheet
         LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
         'Start counting rows of the Data sheet.
         For A = 3 To LastRow
            'Take the Description and place in A1 of template sheet.
            WS2.Range("A1") = .Range("C" & A)
            'Start counting rows of template sheet
            For B = 3 To LR
                'Insert from data sheet to template sheet for Column B & N.
                WS2.Range("B" & B) = .Range("C" & A)
                WS2.Range("N" & B) = .Range("B" & A) & "-" & Right("0" & B - 1, 2)
            Next
            'Parse the path from the opened data sheet.
            MyPath = Left(FN, InStrRev(FN, "\"))
            'Assign next available open file to variable.
            FF = FreeFile
            'OPen CSV file for write.
            Open MyPath & WS.Range("B" & A) & ".csv" For Output As #FF
                'Start counting rows from template
                For I = 2 To LR - 1
                    'Start counting columns -1 from template
                    For J = 1 To 26
                        'Write value plus a trailing comma.
                        Print #FF, WS2.Cells(I, J) & ",";
                    Next
                        'Add a seperate write to prevent trailing comma.
                        Print #FF, WS2.Cells(LR, 27)
                Next
            'Close CSV file
            Close #FF
        'Start next group.
         Next
     End With
    'Close sample file
    WB.Close False
End If

End Sub

[Tinbendr]

It's the line before.

I is rows, J is Columns.

If you want to make that dynamic as well, you'll have to explain where the suffix of the Name comes from.

I would move B16 to a variable so we could use a LastRow function to make the template dynamic.

[snuffnchess]

Thank you again for the info. I will play around with it and let you knowing I have any other questions. Thank you for adding notes to the code so that I can learn from it as well. Truly awesome.