Extract groups of data from a table into different .txt files

bpoese

New Member
Joined
Oct 2, 2006
Messages
18
I have a table that tells me what parts need to be purchased and one of the columns tells me which vendor the part is ordered from.

I need to be able to run a code that will extract all of the parts from one vendor and copy them to a new text file in a specific folder named for the vendor and date created.

The reason for the text file is by dumping the extracted data into a specific folder as a text file our software will be able to pull that data into itself and automatically create the purchase order and prepare it for approval and submission.

I have searched through the forum, but I'm having trouble finding anything on how to extract the data from one table and create multiple files not to mention tab delimited text files.


Thanks in advance for any help you can offer.
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

BrianB

Well-known Member
Joined
Feb 17, 2003
Messages
8,127
Here is the basic code ...
Code:
'===========================================================================
'- MACRO TO EXTRACT ROWS OF DATA FROM A WORKSHEET TO TAB DELIMITED TEXT FILE
'- THIS VERSION ENABLES EXTRACT OF ROWS DEPENDING ON A CELL CONTENT IN THE ROW
'- USES VARIABLE "ExtractValue" TO EXTRACT ROWS & NAME THE TEXT FILE & FOLDER
'- DELETES EXISTING TEXT FILE. MAKES A NEW FOLDER IF IT DOES NOT EXIST
'---------------------------------------------------------------------------
'- Method
'- 1. WORKSHEET HAS TO BE SET UP AS A SIMPLE TABLE.
'- 2. SET VARIABLE "ExtractValue" = Cell content
'- 3. SET VARIABLE "TargetFolder"
'- 5. RUN MACRO FROM THE SHEET
'- eg. here Column 1 contains the word "Vendor"
'- Brian Baulsom April 2002. Amended November 2010
'===========================================================================
'-
Sub EXPORT_DATA_TO_TEXT()
    '- Text File variables
    Dim ExtractValue As String
    Dim TargetFolder As String
    Dim TextFileName As String
    Dim Counter As Integer
    '-------------------------
    Dim MyRow As Long
    Dim MyCol As Integer
    Dim MyReturn As String
    Dim ws As Worksheet
    Dim LastRow As Long
    Dim ColumnCount As Integer
    Dim MyDelimiter As String
    '====================================================================
    '- SET THE VARIABLES FOR DATA EXTRACT *******************************
    ExtractValue = "Vendor"   ' value in column 1. (case sensitive)
    TargetFolder = "F:\" & ExtractValue & "\"   ' nb. final backslash
    TextFileName = TargetFolder & ExtractValue & ".txt"
    '====================================================================
    '- MAKE A NEW FOLDER IF REQUIRED
    If Dir(TargetFolder) = "" Then
        MkDir TargetFolder
    Else
        '- DELETE THE OLD FILE IF IT EXISTS
        If Dir(TextFileName) <> "" Then Kill TextFileName
    End If
    '--------------------------------------------------------------------
    Application.Calculation = xlCalculationManual
    '- set the delimiter required
    MyDelimiter = Chr(9)    ' tab delimiter
    MyReturn = Chr(13)
    '---------------------------------------------------------------------
    Set ws = ActiveSheet
    Counter = 0
    '----------------------------------------------------------------------
    '- get number of rows (to allow for blank cells)
    LastRow = ws.Cells.Find(What:="*", SearchDirection:=xlPrevious, _
        SearchOrder:=xlByRows).Row
    '----------------------------------------------------------------------
    '- get number of columns
    ColumnCount = ws.Cells.Find(What:="*", SearchDirection:=xlPrevious, _
        SearchOrder:=xlByColumns).Column
    '----------------------------------------------------------------------
    '- main loop : EXPORT TO FILE ROW BY ROW
    '----------------------------------------------------------------------
    Open TextFileName For Append As #1
    '- loop through rows & columns
    For MyRow = 1 To LastRow
        Application.StatusBar = MyRow & "\" & LastRow
        '------------------------------------------------------------------
        '- CHECK CELL VALUE. COPY ROW TO THE TEXT FILE
        If ws.Cells(MyRow, 1).Value = ExtractValue Then
            Counter = Counter + 1
            For MyCol = 1 To ColumnCount
                Print #1, ws.Cells(MyRow, MyCol).Value;
                If MyCol < ColumnCount Then Print #1, MyDelimiter;   ' Column
            Next
            Print #1, MyReturn;   ' end of line Return
        End If
        '------------------------------------------------------------------
    Next
    '----------------------------------------------------------------------
    Close #1
    MsgBox ("Extracted " & Counter & " records to file ..." & vbCr & TextFileName)
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = False
End Sub
'=========== END OF PROCEDURE =============================================
 

Watch MrExcel Video

Forum statistics

Threads
1,129,981
Messages
5,639,368
Members
417,083
Latest member
vijaykrrao

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top