Macro to fetch csv file and edit the file

Hi Team,

I got a code from this forum to create a macro and fetch a csv file. Code is as below. Now after fetching the csv file, i am not just going to save in my desktop instead my macro should edit the csv file and add the table name in the first line of the csv file. Because i have to upload this csv file to my web application which will store the data in the table

Code:

---

Sub SaveasCSV()
    Dim strPath        As String
    Dim strFileName    As String
   
    strPath = "C:\Users\324954\Desktop\" ' Use your Path
    strFileName = "MyFile" ' Use your File Name
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=strPath & strFileName, _
        FileFormat:=xlCSV, CreateBackup:=False
    Application.DisplayAlerts = True
End Sub

---

Also in my excel file where user will enter the data and run the macro, not all the columns are fetched into a csv file only some selected columns will be fetched as csvfile1, remaining columns will be fetched as another csv file say csv file2.
In simple words running my macro user should get two csv files. Columns I can hardcode in my code like which columns will fit into csvfile 1 and which all to next file. User will not know that.
Kindly let me know how i can achieve that.

Please advise and provide me some help in coding the same.

Regards
Dhivya

Hi Please Paste both codes and Change Red Items according to Your Need activate the Sheet where data is and run the code------------

Code:

---


Option Explicit

Sub SaveExcelasCSV()
   
   
    Dim strFirstCSVName    As String
    Dim strSecondCSVName    As String
    Dim strFirstTable      As String
    Dim strSecondTable      As String
    Dim strSaveLocation    As String
   
    Dim strCSV_1_Columns    As String
    Dim strCSV_2_Columns    As String
    Dim strRange            As String
   
    Dim wksAct              As Worksheet
    Dim wbkNew              As Workbook
    Dim rngUsedRng          As Range
    Dim lngLastRow          As Long
   
    ''''''''' Change According to your requirement================
    strFirstCSVName = "First"
    strSecondCSVName = "Second"
    strFirstTable = "FirstTable"
    strSecondCSVName = "SecondTable"
    strCSV_1_Columns = "A:C,E,G,I" ' Let Say Column A to C and Columns E, G, and I
    strCSV_2_Columns = "D,F,H,J:L" ' Let Say Columns D,F,H and Columns J to L   
    strSaveLocation = "C:\Users\kbdf775\Desktop\"
  '''''''''===============================================   
    Set wksAct = ActiveSheet
    Set wbkNew = Workbooks.Add(1)
    With wksAct
        Set rngUsedRng = .UsedRange
        lngLastRow = rngUsedRng.Rows.Count
        strRange = MakeRange(strCSV_1_Columns)
        .Range(strRange).Copy
       
        wbkNew.Sheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
        wbkNew.Sheets(1).Rows(1).Insert
        wbkNew.Sheets(1).Rows(1).Insert
        wbkNew.Sheets(1).Cells(1).Value = strFirstTable
        Application.DisplayAlerts = False
        wbkNew.SaveAs Filename:=strSaveLocation & strFirstCSVName, FileFormat:=xlCSV, CreateBackup:=False
        Application.DisplayAlerts = True
       
        wbkNew.Sheets(1).Cells.Clear
        strRange = MakeRange(strCSV_2_Columns)
        .Range(strRange).Copy
        wbkNew.Sheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
        wbkNew.Sheets(1).Rows(1).Insert
        wbkNew.Sheets(1).Rows(1).Insert
        wbkNew.Sheets(1).Cells(1).Value = strSecondTable
        Application.DisplayAlerts = False
        wbkNew.SaveAs Filename:=strSaveLocation & strSecondCSVName, FileFormat:=xlCSV, CreateBackup:=False
        Application.DisplayAlerts = True
        wbkNew.Close 0
    End With
End Sub

---

Code:

---


Function MakeRange(strString As String)

    Dim varSplit    As Variant
    Dim lngVar      As Long
    Dim strMain    As String
   
    varSplit = Split(strString, ",")
   
    For lngVar = 0 To UBound(varSplit)
        If Len(varSplit(lngVar)) = 1 Or InStr(1, varSplit(lngVar), ":") = 0 Then
            If strMain = "" Then
                strMain = varSplit(lngVar) & ":" & varSplit(lngVar)
            Else
                strMain = strMain & "," & varSplit(lngVar) & ":" & varSplit(lngVar)
            End If
        Else
            If strMain = "" Then
                strMain = varSplit(lngVar)
            Else
                strMain = strMain & "," & varSplit(lngVar)


            End If
        End If
    Next
    MakeRange = strMain
End Function

---

HTH
---------------------------------------------------------

Hi littleittin,

Thank you so much this give me a right direction to proceed. now this fetches the selected columns, if I need to add additional columns to the csv file extracted what can I do.

Please help

Change Below lines in Red section accordingly -------------------------

Code:

---

strCSV_1_Columns = "A:C,E,G,I" ' Let Say Column A to C and Columns E, G, and I
strCSV_2_Columns = "D,F,H,J:L" ' Let Say Columns D,F,H and Columns J to L

---

Quote:

---

Originally Posted by littleiitin

Change Below lines in Red section accordingly -------------------------

Code:

---

strCSV_1_Columns = "A:C,E,G,I" ' Let Say Column A to C and Columns E, G, and I
strCSV_2_Columns = "D,F,H,J:L" ' Let Say Columns D,F,H and Columns J to L

---

---

Hi Littleiitin,

I could not see any code in red in your above reply.

I wanted to add some more new columns to csv which are not present in the user's excel sheet.

i tried the below code, which added the column names, now to add values to those columns i am stuck up with. Also i wanted to add these values to all the rows in csv for eg in the attached csv IS_ACTIVE is the column which i added extra using my modified code below, and i wanted to fill the default value as Y till the rows it has data in it.

Code:

---

strFirstCSVName = "First"
    strSecondCSVName = "Second"
    strFirstTable = "RATE_OFFERING"
    strSecondTable = "RATE_GEO"
    FirstTable_Col1 = "IS_ACTIVE"
    strCSV_1_Columns = "A:E" ' Let Say Column A to C and Columns E, G, and I
    strCSV_2_Columns = "F:G,I" ' Let Say Columns D,F,H and Columns J to L
    strSaveLocation = "C:\Users\13124\Desktop\"
  '''''''''===============================================
    Set wksAct = ActiveSheet
    Set wbkNew = Workbooks.Add(1)
    With wksAct
        Set rngUsedRng = .UsedRange
        lngLastRow = rngUsedRng.Rows.Count
        strRange = MakeRange(strCSV_1_Columns)
        .Range(strRange).Copy
       
        wbkNew.Sheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
        wbkNew.Sheets(1).Rows(1).Insert
      '  wbkNew.Sheets(1).Columns(1).Insert
    '  wbkNew.Sheets(1).Rows(1).Insert
        wbkNew.Sheets(1).Cells(1).Value = strFirstTable
      wbkNew.Sheets(1).Rows(2).Cells(6).Value = FirstTable_Col1

---

Please advice

Copy the first set of columns to a separate workbook. Save that workbook as csv-file
Copy the second set of columns to a separate workbook. Save that workbook as csv-file.

Thanks i got the code to work

Code:

---

  wbkNew.Sheets(1).Range("L3").Activate        'DOMAIN_NAME
                For i = 1 To wbkNew.Sheets(1).Range("A1").End(xlDown).Row - 2
                ActiveCell.Value = "GRK"
                ActiveCell.Offset(1).Activate
                Next i
                wbkNew.Sheets(1).Range("A1").Activate

---