Create CSV file from Excel data for an each distinct value in a column?

Question

I have an excel with vendor codes(NUMBERS) as one of the columns.

VENDORITEM|  DESCRIPTION  |PRICE|PRICEGROUP|VENDOR NUMBER|PRODUCT CATEGORY
_______________________________
HNM36789  |30ML FLUID CLIN|50.00|    B     |  023445     |CMI

TNG78934  |BACK PAD 3X5"  |32.00|    D     |  000905     |CMI

JPD12780  |FLEX DRILL GH  |9.50 |    R     |  233590     |MISC

I need to create an excel vba macro so that I can export the data for each vendor number into a csv file and give the csv filename something like 023445NEW, and specify a folder to save all the csv files ? Currently, I doing this manually and taking lot of time.

I am VBA newbie, I know only basic syntax. But I got no idea of how to do it. — inquest, Oct 05 '17 at 16:08
Refer [this](https://stackoverflow.com/questions/46509465/create-rename-sheets-and-export-them-as-csv/46510042#46510042) — Dy.Lee, Oct 05 '17 at 16:48
linked vba convert range to csv. You can use this code if some code line edited. — Dy.Lee, Oct 05 '17 at 16:52
Thanks @Dy.Lee i have tried with your code but I m not fully achieving what is needed. it is returning only one item per vendorcode. It does not seem correct for vendorcodes that have more than one item rows. I have even tried sorting of the file first but it didn't work. Any idea how I can achieve this when there is more than one row data per vendorcode?Thanks in advance — inquest, Jan 01 '18 at 23:44

score 1 · Accepted Answer · edited Oct 18 '20 at 20:22

This convert range to csv.

Sub SaveRangeToCsvFiles()
    Dim FileName As String
    Dim Ws As Worksheet
    Dim rngDB As Range
    Dim r As Long, c As Long
    Dim pathOut As String
    Dim i As Long

    pathOut = ThisWorkbook.Path & "\" ' set your path:  C:\temp\

    Set Ws = ActiveSheet 'Sheets("AllData")
    With Ws
        r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        'c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        For i = 2 To r
            Set rngDB = .Range("a" & i).Resize(1, 6)
            FileName = .Range("a" & i).Offset(, 4) & "NEW"
            TransToCSV pathOut & FileName & ".csv", rngDB
        Next i
    End With
    MsgBox ("Files Saved Successfully")
End Sub
Sub TransToCSV(myfile As String, rng As Range)

    Dim vDB, vR() As String, vTxt()
    Dim i As Long, n As Long, j As Integer
    Dim objStream
    Dim strTxt As String

    Set objStream = CreateObject("ADODB.Stream")
    vDB = rng
    For i = 1 To UBound(vDB, 1)
        n = n + 1
        ReDim vR(1 To UBound(vDB, 2))
        For j = 1 To UBound(vDB, 2)
            vR(j) = vDB(i, j)
        Next j
        ReDim Preserve vTxt(1 To n)
        vTxt(n) = Join(vR, ",")
    Next i
    strTxt = Join(vTxt, vbCrLf)
    With objStream
        '.Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile myfile, 2
        .Close
    End With
    Set objStream = Nothing

End Sub

Create CSV file from Excel data for an each distinct value in a column?

1 Answers1

Linked