Macro to fetch csv file and edit the file

[dhivya.enjoy]

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





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

[littleiitin]

Hi Please Paste both codes and Change Red Items according to Your Need activate the Sheet where data is and run the 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





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

[dhivya.enjoy]

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

[littleiitin]

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



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

[dhivya.enjoy]

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



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.


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

[snb]

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.

[dhivya.enjoy]

Thanks i got the code to work


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