+ Reply to Thread
Results 1 to 10 of 10

Automate CSV creation with unique file names

Hybrid View

  1. #1
    Spammer
    Join Date
    11-21-2014
    Location
    California
    MS-Off Ver
    2010
    Posts
    387

    Automate CSV creation with unique file names

    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
    Attached Files Attached Files

  2. #2
    Forum Expert Tinbendr's Avatar
    Join Date
    06-26-2012
    Location
    USA
    MS-Off Ver
    Office 2010
    Posts
    2,138

    Re: Automate CSV creation with unique file names

    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
    David
    (*) Reputation points appreciated.

  3. #3
    Spammer
    Join Date
    11-21-2014
    Location
    California
    MS-Off Ver
    2010
    Posts
    387

    Re: Automate CSV creation with unique file names

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

  4. #4
    Spammer
    Join Date
    11-21-2014
    Location
    California
    MS-Off Ver
    2010
    Posts
    387

    Re: Automate CSV creation with unique file names

    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???

  5. #5
    Forum Guru
    Join Date
    08-15-2004
    Location
    Tokyo, Japan
    MS-Off Ver
    2013 O.365
    Posts
    22,835

    Re: Automate CSV creation with unique file names

    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

  6. #6
    Forum Expert Tinbendr's Avatar
    Join Date
    06-26-2012
    Location
    USA
    MS-Off Ver
    Office 2010
    Posts
    2,138

    Re: Automate CSV creation with unique file names

    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

  7. #7
    Spammer
    Join Date
    11-21-2014
    Location
    California
    MS-Off Ver
    2010
    Posts
    387

    Re: Automate CSV creation with unique file names

    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???

  8. #8
    Forum Expert Tinbendr's Avatar
    Join Date
    06-26-2012
    Location
    USA
    MS-Off Ver
    Office 2010
    Posts
    2,138

    Re: Automate CSV creation with unique file names

    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
    Attached Files Attached Files

  9. #9
    Forum Expert Tinbendr's Avatar
    Join Date
    06-26-2012
    Location
    USA
    MS-Off Ver
    Office 2010
    Posts
    2,138

    Re: Automate CSV creation with unique file names

    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.

  10. #10
    Spammer
    Join Date
    11-21-2014
    Location
    California
    MS-Off Ver
    2010
    Posts
    387

    Re: Automate CSV creation with unique file names

    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.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. How to Automate the Creation of PPT
    By balajisx in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 06-28-2017, 10:58 AM
  2. Excel file creation dates do not match the windows creation date.
    By alexthapyro in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 07-26-2011, 12:14 PM
  3. Replies: 2
    Last Post: 08-18-2006, 11:00 AM
  4. automate creation of sheets in excel
    By Daniel in forum Excel Formulas & Functions
    Replies: 0
    Last Post: 09-06-2005, 10:05 AM
  5. [SOLVED] automate creation of sheets in excel
    By Daniel in forum Excel Formulas & Functions
    Replies: 0
    Last Post: 09-06-2005, 12:05 AM
  6. automate creation of sheets in excel
    By Daniel in forum Excel Formulas & Functions
    Replies: 1
    Last Post: 06-23-2005, 06:05 PM
  7. [SOLVED] HOW DO I AUTOMATE CREATION OF JOB SHEETS?
    By bobby smith in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 06-14-2005, 08:05 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1