Creating single and separate CSV files based on excel cell value for multiple rows

[lerac]

Hi there I have been trying with my very limited knowledge to create CSV files with a excel sheet. I have managed to create a CSV file for every single row which is not what I am trying to achieve. After googling for hours with many failed attempts I was hoping to get some help from here.

This is the only code I got working sadly enough

Sub GenerateCSV()Max = Application.WorksheetFunction.CountA(Range("D:D"))
    For i = 3 To Max
            t = Range("D2") & vbNewLine & Cells(i, 4).Value
            p = Cells(i, 2)
            f = Cells(i, 2).Value & "\" & Cells(i, 1).Value & " TypeA" & ".csv"
            X = Dir(p, vbDirectory)
            If X = "" Then MkDir p
            Set fs = CreateObject("Scripting.FileSystemObject")
            Set a = fs.CreateTextFile(f, True)
            a.Write (t)
            a.Close
    Next i
End Sub

My sheet is as follows
- A3, A4 etc (unless empty) contains the filename the CSV file should have
- B3, B4 etc (unless empty) contains the filepath (for instance C:\Temp)
- C3, C4 etc (unless empty) contains the answer with Yes or No to the question should it combine this row
- D2 contains the header every single created CSV file should have on the first line. Meaning it should NOT be more then once in each CSV file and has to be put in LINE 1 of CSV file
- D3, D4 etc (unless empty) contains the text each row has that needs to be put underneath the header and each other (if there are more then 1 YES available)

I can't seem to manage to create a single CSV file containing the header (D2) and then add each row containing YES in C3,C4 etc also into the same CSV file using the first file name and filepath row it comes across.

Also when C3, C4 etc does contains a NO it should create a separate CSV file with the data from that specific row has including the header. Kinda like the my code is working now but with the difference it should look for the rows containing NO in C3, C4 etc.

I am not a vba wizard and bet I am way over my head with this complex CSV file creating, but no I have perhaps I can get a yes here.

 

[ExcelSpeedster]

This doesn't sound too complicated to fix. Please post your file and I'll take a look for you. You can share a link to the file with any cloud storage app (Google Drive, OneDrive, etc.).

 

[lerac]

Wow that sounds great, here is a example file I am using trying to create this macro.

Thank you for helping

 

[ExcelSpeedster]

Here is the solution:

Sub GenerateCSV()
    
    Max = Application.WorksheetFunction.CountA(Range("D:D")) + 1
    i = 3
    
    While i <= Max
        'Find the first instance of a "Yes"
        If Cells(i, 3).Value = "Yes" Then
            'Set the title value
            t = Range("D2")
        
            'Loop through the remainder of the rows to find all "Yes" rows and build a single file
            For j = i To Max
                If Cells(j, 3).Value = "Yes" Then
                    t = t & vbNewLine & Cells(j, 4).Value
                End If
            Next j
            
            'Create the file for "Yes" values
            p = Cells(i, 2)
            f = Cells(i, 2).Value & "\" & Cells(i, 1).Value & " TypeA" & ".csv"
            X = Dir(p, vbDirectory)
            If X = "" Then MkDir p
            Set fs = CreateObject("Scripting.FileSystemObject")
            Set a = fs.CreateTextFile(f, True)
            a.Write (t)
            a.Close
            
            'Exit the loop because the "Yes" file has been created
            i = Max
        End If
    
        i = i + 1
    Wend
    
    'Create the "No" files
    For i = 3 To Max
        If Cells(i, 3).Value = "No" Then
            t = Range("D2") & vbNewLine & Cells(i, 4).Value
            p = Cells(i, 2)
            f = Cells(i, 2).Value & "\" & Cells(i, 1).Value & " TypeA" & ".csv"
            X = Dir(p, vbDirectory)
            If X = "" Then MkDir p
            Set fs = CreateObject("Scripting.FileSystemObject")
            Set a = fs.CreateTextFile(f, True)
            a.Write (t)
            a.Close
        End If
    Next i
End Sub

Please note that the last row in your example file says "Ja" instead of "Yes".

 

[lerac]

Works like a charm, you make it look easy. Also pointing out the typo like it was not enough.

Thank you!