Specifying a cell value in double quotation marks: Excel VBA Macro

Question

I want to put double quotes in all cells in a specific column. I wrote code to put double quotes, but the problem is that it puts 3 double quotes around the value.

For Each myCell In ActiveWorkbook.Sheets("Sheet1").Range("B:B") If myCell.Value <> "" Then myCell.Value = Chr(34) & myCell.Value & Chr(34) End If Next myCell 

The basic requirement is to split the excel file according to column B and save them as CSV files.
In broken form, the values ​​of columns B and D must be enclosed in double quotation marks.

Full code:

 Option Explicit Sub ParseItems() Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long Dim ws As Worksheet, MyArr As Variant, vTitles As String, SvPath As String Dim myCell As Range, transCell As Range 'Sheet with data in it Set ws = Sheets("Sheet1") 'Path to save files into, remember the final \ SvPath = "D:\SplitExcel\" 'Range where titles are across top of data, as string, data MUST 'have titles in this row, edit to suit your titles locale 'Inserting new row to act as title, copying the data from first row in title, row deleted after use ws.Range("A1").EntireRow.Insert ws.Rows(2).EntireRow.Copy ws.Range("A1").Select ws.Paste vTitles = "A1:Z1" 'Choose column to evaluate from, column A = 1, B = 2, etc. vCol = 2 If vCol = 0 Then Exit Sub 'Spot bottom row of data LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row 'Speed up macro execution Application.ScreenUpdating = False 'Get a temporary list of unique values from key column ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True 'Sort the temporary list ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal 'Put list into an array for looping (values cannot be the result of formulas, must be constants) MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants)) 'clear temporary worksheet list ws.Range("EE:EE").Clear 'Turn on the autofilter, one column only is all that is needed 'ws.Range(vTitles).AutoFilter 'Loop through list one value at a time For Itm = 1 To UBound(MyArr) ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm) 'transCell = ws.Range("A2:A" & LR) ws.Range("A2:A" & LR).EntireRow.Copy Workbooks.Add Range("A1").PasteSpecial xlPasteAll Cells.Columns.AutoFit MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1 For Each myCell In ActiveWorkbook.Sheets("Sheet1").Range("B:B") If myCell.Value <> "" Then myCell.Value = Chr(34) & myCell.Value & Chr(34) End If Next myCell ActiveWorkbook.SaveAs SvPath & "po" & MyArr(Itm) & ActiveWorkbook.Sheets("Sheet1").Range("D1") & "." & Date2Julian(Date), xlCSV, local:=False ActiveWorkbook.Close False ws.Range(vTitles).AutoFilter Field:=vCol Next Itm 'Cleanup ws.Rows(1).EntireRow.Delete ws.AutoFilterMode = False Application.ScreenUpdating = True End Sub Function Date2Julian(ByVal vDate As Date) As String Date2Julian = Format(DateDiff("d", CDate("01/01/" _ + Format(Year(vDate), "0000")), vDate) _ + 1, "000") End Function 

Examples of input:

 24833837 8013 70 1105 25057089 8013 75 1105 25438741 8013 60 1105 24833837 8014 70 1106 25057089 8014 75 1106 25438741 8014 60 1106 

Expected Result: two files created with the following data

File 1:

 24833837,"8013",70,1105 25057089,"8013",75,1105 25438741,"8013",60,1105 

File 2:

 24833837,"8014",70,1106 25057089,"8014",75,1106 25438741,"8014",60,1106 

Resulting output:

File 1:

 24833837,"""8013""",70,1105 25057089,"""8013""",75,1105 25438741,"""8013""",60,1105 

Same for file 2

Kind help. :)

Answer 1

Afaik, there’s no easy way to trick Excel into using quotes around numbers using the usual “save as csv” procedure. However, you can use VBA to save in any csv format you like.

Take sample code from https://support.microsoft.com/en-us/help/291296/procedure-to-export-a-text-file-with-both-comma-and-quote-delimiters-in-excel

Just add an if-statement to determine whether to use quotation marks or not

 ' Write current cell text to file with quotation marks. If WorksheetFunction.IsText(Selection.Cells(RowCount, ColumnCount)) Then Print #FileNum, """" & Selection.Cells(RowCount, _ ColumnCount).Text & """"; Else Print #FileNum, Selection.Cells(RowCount, _ ColumnCount).Text; End If 

The WorksheetFunction.IsText recognizes your numbers as text if they are entered from the previous one (one high quote)

You will need to adjust the example to export the range you want with the predefined file name from your code.

Answer 2

This little stand will do what you need. Just give it the file name fname , the range to export as csv rg and the column number column_with_quotes - so something like this, but with a range suitable:

 save_as_csv_with_optional_quotes SvPath & "po" & MyArr(Itm) & ActiveWorkbook.Sheets("Sheet1").Range("D1") & "." & Date2Julian(Date), Range("A1:C5"), 2 

Here under:

 Sub save_as_csv_with_optional_quotes(fname As String, rg As Range, column_with_quotes As Long) Dim ff, r, c As Long Dim loutput, cl As String ff = FreeFile Open fname For Output As ff For r = 1 To rg.Rows.Count loutput = "" For c = 1 To rg.Columns.Count If loutput <> "" Then loutput = loutput & "," cl = rg.Cells(r, c).Value If c = column_with_quotes Then cl = Chr$(34) & cl & Chr$(34) loutput = loutput & cl Next c Print #ff, loutput Next r Close ff End Sub 

Answer 3

the problem is in this line.

 myCell.Value = Chr(34) & myCell.Value & Chr(34) 

The quotation marks you add are then quoted again when exporting in CSV format, so there are three quotation marks on each side of the value. The best option, I think, is to change the format of the myCell number for the text, not the number. I have not tried this, but I think changing this on this should help.

 myCell.Value = Chr(39) & myCell.Value 

Chr (39) is an apostrophe, and when you enter it as the first character of a cell value, it forces the format to be Text.