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

Lars1

Board Regular
Joined
Feb 3, 2021
Messages
158
Office Version
  1. 365
Platform
  1. Windows
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
ABC
1Column 1Column 2Column 3
2podr 121Hat 63
3podr 132Hat 69
4podr 143Hat 75
5podr 154Hat 81
6podr 165Hat 87
7podr 176Hat 93
8podr 187Hat 99
9podr 198Hat 105
10podr 209Hat 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
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Try this macro:
VBA Code:
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
 
Upvote 0
Hi, according to the initial attachment a VBA demonstration for starters :​
VBA Code:
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
 
Upvote 0
Try this macro:
VBA Code:
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.
 
Upvote 0
Try this macro:
VBA Code:
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... ?
 
Upvote 0
Replace the Open to Close lines with:
VBA Code:
    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
 
Upvote 0
Solution
Replace the Open to Close lines with:
VBA Code:
    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 :-)
 
Upvote 0

Forum statistics

Threads
1,223,908
Messages
6,175,305
Members
452,633
Latest member
DougMo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top