excel save as csv with quotes around specific columns

[BKChedlia]

Hi,
I have an excel file, that I want to save as csv, but I cannot save with quotes around some columns, so I found 2 codes to add quotes but it will apply it around all the column
this is the first code

[COLOR=#333333]Sub CSVFile()[/COLOR]

[COLOR=#333333]Dim SrcRg As Range[/COLOR]
[COLOR=#333333]Dim CurrRow As Range[/COLOR]
[COLOR=#333333]Dim CurrCell As Range[/COLOR]
[COLOR=#333333]Dim CurrTextStr As String[/COLOR]
[COLOR=#333333]Dim ListSep As String[/COLOR]
[COLOR=#333333]Dim FName As Variant[/COLOR]
[COLOR=#333333]FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")[/COLOR]

[COLOR=#333333]If FName <> False Then[/COLOR]
[COLOR=#333333]ListSep = Application.International(xlListSeparator)[/COLOR]
[COLOR=#333333]If Selection.Cells.Count > 1 Then[/COLOR]
[COLOR=#333333]Set SrcRg = Selection[/COLOR]
[COLOR=#333333]Else[/COLOR]
[COLOR=#333333]Set SrcRg = ActiveSheet.UsedRange[/COLOR]
[COLOR=#333333]End If[/COLOR]
[COLOR=#333333]Open FName For Output As #1[/COLOR]
[COLOR=#333333]For Each CurrRow In SrcRg.Rows[/COLOR]
[COLOR=#333333]CurrTextStr = ""[/COLOR]
[COLOR=#333333]For Each CurrCell In CurrRow.Cells[/COLOR]
[COLOR=#333333]CurrTextStr = CurrTextStr & """" & CurrCell.Value & """" & ListSep[/COLOR]
[COLOR=#333333]Next[/COLOR]
[COLOR=#333333]While Right(CurrTextStr, 1) = ListSep[/COLOR]
[COLOR=#333333]CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)[/COLOR]
[COLOR=#333333]Wend[/COLOR]
[COLOR=#333333]Print #1, CurrTextStr[/COLOR]
[COLOR=#333333]Next[/COLOR]
[COLOR=#333333]Close #1[/COLOR]
[COLOR=#333333]End If[/COLOR]
[COLOR=#333333]End Sub[/COLOR]

this is the second code

Option Explicit

Sub CreateCSV()


    Dim LastRow As Long
    Dim LastColumn As Long
    Dim i As Long
    Dim j As Long


    With ActiveSheet.UsedRange
        LastRow = .Rows.Count + .Rows(1).Row - 1
        LastColumn = .Columns.Count + .Columns(1).Column - 1
    End With
    
    'Change the path and file name accordingly
    Open "C:\Users\cben\Documents\BKC\IATA\FS_AIMS\test\Filename.csv" For Output As #1
        For i = 1 To LastRow
            For j = 1 To LastColumn
                If j <> LastColumn Then
                    Write #1, CStr(Cells(i, j).Value);
                Else
                    Write #1, CStr(Cells(i, j).Value)
                End If
            Next j
        Next i
    Close #1
    
    MsgBox "Completed...", vbInformation
    
End Sub

This is my data all column are using quotes expect column "STATUS" and column "BANK_GUARANTEE_AMOUNT"

"CODE","LEGAL_NAME","TRADING_NAME","COUNTRY","CURRENCY","LANGUAGE","STATUS","BANK_NAME","BANK_GUARANTEE_AMOUNT","BANK_GUARANTEE_CURRENCY","BANK_GUARANTEE_EXPIRY_DATE","ACCREDITATION_DATE","CLASS","LOCATION_TYPE","XREF","IRRS","TAX_CODE","CITY","ISO_CTRY_CODE","DEF","OWN/SHARE CHANGE","OWN/SHARE LAST DATE","CHO","DEF"
"97500023","CARIBBEAN WORLD","GOING","ANTIGUA AND BARBUDA","XCD","ENG",9,"",,"","","19-JAN-50","P","BR","98500010","0","","ST. JOHN'S","AG","0","","","",""

Thanks

 

[BKChedlia]

I updated my code like this :

Option Explicit

Sub CreateCSV()


    Dim LastRow As Long
    Dim LastColumn As Long
    Dim i As Long
    Dim j As Long


    With ActiveSheet.UsedRange
        LastRow = .Rows.Count + .Rows(1).Row - 1
        LastColumn = .Columns.Count + .Columns(1).Column - 1
    End With
    
    'Change the path and file name accordingly
    Open "C:\Users\cben\Documents\BKC\.....\test\File4.csv" For Output As #1


       i = 1
       
         For j = 1 To LastColumn
          If i = 1 Then
          Write #1, CStr(Cells(i, j).Value);
          End If
           Next j
      
         For i = 2 To 4
        
            For j = 1 To LastColumn
                If j <> LastColumn And j <> 7 And j <> 9 Then
                    Write #1, CStr(Cells(i, j).Value);
                   
                ElseIf j = 7 Then
                 Print #1, Cells(i, j).Value & ",";
                 
                   ElseIf j = 9 Then
                 Print #1, Cells(i, j).Value & ",";
                 
                Else
                    Write #1, CStr(Cells(i, j).Value)
               
                 End If
            Next j
           
        Next i
        
    Close #1
  
    
End Sub

but the 1rst and second lines are now concateneated

"CODE","LEGAL_NAME","TRADING_NAME","COUNTRY","CURRENCY","LANGUAGE","STATUS","BANK_NAME","BANK_GUARANTEE_AMOUNT","BANK_GUARANTEE_CURRENCY","BANK_GUARANTEE_EXPIRY_DATE","ACCREDITATION_DATE","CLASS","LOCATION_TYPE","XREF","IRRS","TAX_CODE","CITY","ISO_CTRY_CODE","DEF","OWN/SHARE CHANGE","OWN/SHARE LAST DATE","CHO_CHI","DEF_NONPAYMENT","97500023","CARIBBEAN WORLD TRAVEL SERVICES LTD.","GOING PLACES TRAVEL","ANTIGUA AND BARBUDA","XCD","ENG",9,"",,"","","1/19/1950","P","BR","98500010","0","","ST. JOHN'S","AG","0","","","",""
"97500196","WINGS INC.","WINGS TRAVEL ADVENTURES","ANTIGUA AND BARBUDA","XCD","ENG",9,"",,"","","1/14/2005","P","HO","","0","","ST. JOHN'S","AG","0","","","",""

instead of this result

"CODE","LEGAL_NAME","TRADING_NAME","COUNTRY","CURRENCY","LANGUAGE","STATUS","BANK_NAME","BANK_GUARANTEE_AMOUNT","BANK_GUARANTEE_CURRENCY","BANK_GUARANTEE_EXPIRY_DATE","ACCREDITATION_DATE","CLASS","LOCATION_TYPE","XREF","IRRS","TAX_CODE","CITY","ISO_CTRY_CODE","DEF","OWN/SHARE CHANGE","OWN/SHARE LAST DATE","CHO_CHI","DEF_NONPAYMENT"
"97500023","CARIBBEAN WORLD TRAVEL SERVICES LTD.","GOING PLACES TRAVEL","ANTIGUA AND BARBUDA","XCD","ENG",9,"",,"","","1/19/1950","P","BR","98500010","0","","ST. JOHN'S","AG","0","","","",""
"97500196","WINGS INC.","WINGS TRAVEL ADVENTURES","ANTIGUA AND BARBUDA","XCD","ENG",9,"",,"","","1/14/2005","P","HO","","0","","ST. JOHN'S","AG","0","","","",""