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

[bpoese]

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.

 

[BrianB]

Here is the basic 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 =============================================