Create individual Text file from each Excel 2003 row using Macro

[jayant_1970]

Hello !!

I am completely new to VBA. Can someone from community help me achieve following.

I have an excel 2003 worksheet with three columns data as follows:


[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]SYMBOL[/TD]
[TD]LISTING_DATE[/TD]
[TD]FV[/TD]
[/TR]
[TR]
[TD]20MICRONS[/TD]
[TD]06-Oct-08[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]3IINFOTECH[/TD]
[TD]22-Apr-05[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]3MINDIA[/TD]
[TD]13-Aug-04[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]8KMILES[/TD]
[TD]29-Jan-14[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]A2ZINFRA[/TD]
[TD]23-Dec-10[/TD]
[TD]2[/TD]
[/TR]
</tbody>[/TABLE]











1st Row is with heading text (SYMBOL , LISTING_DATE , FV) in column A, B & C.
Column A contains list of SYMBOLS from A2:A1700.
Column B contains list of LISTING_DATE from B2:B1700
Column C contains list of FV from C2:C1700

- I want to create individual .txt files with A2 to A1700 as file name. (example: 20MICRONS.txt)
- Each text file to contains corresponding data from Column B and Column C with comma and space in between them.
example: 20MICRONS.txt file contains data "LISTING_DATE = 06-Oct-08 , FV = 5" in single line.

Any VBA expert help me please.

Thanks in advance.

 

[Domenic]

Hi,

Assuming that the sheet containing the data is the active sheet, try something like this...

[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]

[COLOR=darkblue]Sub[/COLOR] CreateTextFiles()

    [COLOR=darkblue]Dim[/COLOR] sDestPath [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] vData [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=darkblue]If[/COLOR] ActiveSheet [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    
    sDestPath = "C:\Users\Domenic\Desktop\" [COLOR=green]'change the destination path accordingly[/COLOR]
    [COLOR=darkblue]If[/COLOR] Len(sDestPath) > 0 [COLOR=darkblue]Then[/COLOR]
        [COLOR=darkblue]If[/COLOR] Right(sDestPath, 1) <> "\" [COLOR=darkblue]Then[/COLOR]
            sDestPath = sDestPath & "\"
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Else[/COLOR]
        MsgBox "Path not found.", vbCritical
        [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    
    vData = Range("A1:C" & Cells(Rows.Count, "A").End(xlUp).Row).Value
    
    [COLOR=darkblue]For[/COLOR] i = 2 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](vData, 1)
        [COLOR=darkblue]If[/COLOR] Len(vData(i, 1)) > 0 [COLOR=darkblue]Then[/COLOR]
            [COLOR=darkblue]Open[/COLOR] sDestPath & vData(i, 1) & ".txt" [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Output[/COLOR] [COLOR=darkblue]As[/COLOR] #1
                [COLOR=darkblue]Print[/COLOR] #1, vData(1, 2) & " = " & Format(vData(i, 2), "dd-mmm-yy") & ", " & vData(1, 3) & " = " & vData(i, 3)
            [COLOR=darkblue]Close[/COLOR] #1
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] i
    
    MsgBox "Completed...", vbInformation
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Hope this helps!

 

[jayant_1970]

Thank you very much for a code Domenic !!!

I run this code in my excel sheet with change in destination folder. Code works flawlessly.

Thanks for taking your valuable time out to write this code.

This provide me an impetus to learn VB now, as a new hobby in my spare time.

 

[Domenic]

That's great. Thanks for your feedback.

Cheers!