VBA save range as CSV file and add an extra column with fixed text

[Lars1]

Hi

I have a range in Excel i would like to save as CSV file in C:\test\
with filename: PROD + date and time (Format DD-MM-YYYY HH MM)
C:\test\PROD 22-09-2021 12 00.CSV

Besides the three column in my sheet i would like to add a 4. column with a fixed text like "LAG"

Mappe2
	A	B	C
1	Column 1	Column 2	Column 3
2	podr 12	1	Hat 63
3	podr 13	2	Hat 69
4	podr 14	3	Hat 75
5	podr 15	4	Hat 81
6	podr 16	5	Hat 87
7	podr 17	6	Hat 93
8	podr 18	7	Hat 99
9	podr 19	8	Hat 105
10	podr 20	9	Hat 111
Ark1

Ressult should be like this:
Column 1;Column 2;Column 3;Column 4
podr 12;1;Hat 63;LAG
podr 13;2;Hat 69;LAG
podr 14;3;Hat 75;LAG
podr 15;4;Hat 81;LAG
podr 16;5;Hat 87;LAG
podr 17;6;Hat 93;LAG
podr 18;7;Hat 99;LAG
podr 19;8;Hat 105;LAG
podr 20;9;Hat 111;LAG

 

[John_w]

Try this macro:

Public Sub Save_Range_CSV()

    Dim cellData As Variant, i As Long, j As Long
    Dim lines() As String
    
    With ActiveSheet
        cellData = .Range("A1:C1").Resize(.Cells(.Rows.Count, "A").End(xlUp).Row).Value
    End With
    
    ReDim lines(1 To UBound(cellData))
    i = 1
    For j = 1 To 3
        lines(i) = lines(i) & cellData(i, j) & ";"
    Next
    lines(i) = lines(i) & "Column 4"
    For i = 2 To UBound(cellData)
        For j = 1 To 3
            lines(i) = lines(i) & cellData(i, j) & ";"
        Next
        lines(i) = lines(i) & "LAG"
    Next
    
    Open "C:\test\PROD " & Format(Now, "DD-MM-YYYY HH MM") & ".csv" For Output As #1
    Print #1, Join(lines, vbCrLf)
    Close #1
        
End Sub

 

[Marc L]

Hi, according to the initial attachment a VBA demonstration for starters :​

Sub Demo1()
  Const D = ";", P = "C:\test\", S = "Ark1!A1"
    Dim F%, R&
        If Dir(P, 16) <> "." Or Not Evaluate("ISREF(" & S & ")") Then Beep: Exit Sub
        F = FreeFile
        Open P & "PROD " & Format(Now, "dd-mm-yyyy hh mm ") & ".csv" For Output As #F
    With Range(S).CurrentRegion.Rows
            Print #F, Join(Application.Index(.Item(1).Value2, 1, 0), D); D; "Column 4"
        For R = 2 To .Count
            Print #F, Join(Application.Index(.Item(R).Value2, 1, 0), D); D; "LAG"
        Next
    End With
        Close #F
End Sub

 

[Lars1]

Try this macro:

Public Sub Save_Range_CSV()

    Dim cellData As Variant, i As Long, j As Long
    Dim lines() As String
   
    With ActiveSheet
        cellData = .Range("A1:C1").Resize(.Cells(.Rows.Count, "A").End(xlUp).Row).Value
    End With
   
    ReDim lines(1 To UBound(cellData))
    i = 1
    For j = 1 To 3
        lines(i) = lines(i) & cellData(i, j) & ";"
    Next
    lines(i) = lines(i) & "Column 4"
    For i = 2 To UBound(cellData)
        For j = 1 To 3
            lines(i) = lines(i) & cellData(i, j) & ";"
        Next
        lines(i) = lines(i) & "LAG"
    Next
   
    Open "C:\test\PROD " & Format(Now, "DD-MM-YYYY HH MM") & ".csv" For Output As #1
    Print #1, Join(lines, vbCrLf)
    Close #1
       
End Sub

Thanks.
Works perfectly and was a great help for me...

Thanks again.

 

[Lars1]

Try this macro:

Public Sub Save_Range_CSV()

    Dim cellData As Variant, i As Long, j As Long
    Dim lines() As String
   
    With ActiveSheet
        cellData = .Range("A1:C1").Resize(.Cells(.Rows.Count, "A").End(xlUp).Row).Value
    End With
   
    ReDim lines(1 To UBound(cellData))
    i = 1
    For j = 1 To 3
        lines(i) = lines(i) & cellData(i, j) & ";"
    Next
    lines(i) = lines(i) & "Column 4"
    For i = 2 To UBound(cellData)
        For j = 1 To 3
            lines(i) = lines(i) & cellData(i, j) & ";"
        Next
        lines(i) = lines(i) & "LAG"
    Next
   
    Open "C:\test\PROD " & Format(Now, "DD-MM-YYYY HH MM") & ".csv" For Output As #1
    Print #1, Join(lines, vbCrLf)
    Close #1
       
End Sub

Hi again
Is there a way to get a confirmation that the file is saved ?
Maybe a Messagebox or... ?

 

[John_w]

Replace the Open to Close lines with:

    Dim csvFile As String
    csvFile = "C:\test\PROD " & Format(Now, "DD-MM-YYYY HH MM") & ".csv"
    Open csvFile For Output As #1
    Print #1, Join(lines, vbCrLf)
    Close #1    
    MsgBox "Saved " & csvFile

 

[Lars1]

Replace the Open to Close lines with:

    Dim csvFile As String
    csvFile = "C:\test\PROD " & Format(Now, "DD-MM-YYYY HH MM") & ".csv"
    Open csvFile For Output As #1
    Print #1, Join(lines, vbCrLf)
    Close #1   
    MsgBox "Saved " & csvFile

Once again thank you so much