VBA - Import Tab Delimited File and create separate sheets for separate header information in file

M

malfisint1

New Member
Joined
Apr 11, 2018
Messages
8
Hello,
I have a pretty complicated requirement and need some help. My business users receive a credit card file from our vendor and use this file to reconcile against data that is loaded into our financial application. The file has no column titles however has several different header identifiers. I wasn't able to attach an example of the filer as I did not see that option but I have copied it down below. Since I copied it, it will not be in it's most accurate format. I need to load this data into Excel and separate the data according to the header identifiers in separate sheets. How can I accomplish this with VBA? I am very new to VBA so any help would be greatly appreciated.

Explanation of file:
First column of file -
Header Identifier -
6 - File Header - beginning of file
8 - Transaction Header
5th column in this row has transaction identifier
03 - Employee Data
04 - Emp Card Data
05 - Purchase Transaction
09 - Purchase Detail
4 - Transaction Detail
9 - Transaction Footer - End of specific transaction identifier
5th column in this row has transaction identifier
03 - Employee Data
04 - Emp Card Data
05 - Purchase Transaction
09 - Purchase Detail
7 - File Footer - end of file

6 0000010120 00001 02082018 00 0000000000 0000000000000000 4.0 8953 0000000001 1
8 0000010120 00001 02082018 03 0000000000 0000000000000000 4.0 8953 0000000001 1
4 444444444-0000000001 4485000000000001 0010082729 02052018 02052018 00000000 02282021
4 444444444-0000000002 4485000000000002 0010082729 02052018 02052018 00000000 02282021
9 0000010120 00001 02082018 03 0000000954 0000000000000000 4.0 8953 0000000001 1
8 0000010120 00001 02082018 04 0000000000 0000000000000000 4.0 8953 0000000001 1
4 0000010120 000000000-0000604707 0010082729 COMMERCIAL CARD MCC
4 0000010120 000000000-7900001454 0010082729 VENDOR CARD
9 0000010120 00001 02082018 04 0000000954 0000000000000000 4.0 8953 0000000001 1
8 0000010120 00001 02082018 05 0000000000 0000000000000000 4.0 8953 0000000001 1
4 4485000000000001 01082018 24639238007900014302110 0000000002 08000 463923 948000338000575 TEST1 505-3414901 NM 00840 871090000 0000000000005842 0000000000005842 00840 5021 10 01052018
4 4485000000000002 01252018 24270748024017858107025 0000000001 08001 427074 39300981878357 TEST2 610-2688620 PA 00840 193110000 0000000000059413 0000000000059413 00840 1799 10 01242018
9 0000010120 00001 02082018 05 0000000010 0000000000314465 4.0 8953 0000000001 1
8 0000010120 00001 02082018 09 0000000000 0000000000000000 4.0 8953 0000000001 1
4 4485000000000002 01312018 24435658030036006978678 0000000007 0 01282018 0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000 0000000000000000 002 0000000000000000 259663 0000000000014869 01302018 3695
9 0000010120 00001 02082018 09 0000000001 0000000000000000 4.0 8953 0000000001 1
7 0000010120 00001 02082018 00 0000001979 0000000000314465 4.0 8953 0000000001 1

thanks,
Linda
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
Show - in terms of sheets and cells (rows and columns) - how the output of that data should look.
 
Upvote 0
I didn't copy every piece of data but this should give you an idea of how it should be outputted.

Employee Data Sheet
VS_REC_TYPEVS_CARDHOLDER_IDVS_ACCT_NBRVS_HRCHY_NODEVS_EFFDTVS_ACCT_OPEN_DATEVS_ACCT_CLOSE_DATEVS_EXPIRE_DATE
4444444444-0000000001448500000000000100100827290205201802052018002282021
4444444444-0000000002448500000000000200100827290205201802052018002282021

<tbody>
</tbody><colgroup><col><col><col><col><col><col><col><col></colgroup>


Employee Detail Sheet

VS_REC_TYPEVS_COMPANY_IDVS_CARDHOLDER_IDVS_HRCHY_NODEVS_FIRST_NAMEVS_LAST_NAME
410120000000000-000060470710082729COMMERCIAL CARD MCC
410120000000000-790000145410082729VENDOR CARD

<tbody>
</tbody><colgroup><col><col><col><col><col><col></colgroup>

Transactions Sheet
VS_REC_TYPEVS_ACCT_NBRVS_POSTING_DTEVS_CCTRANS_NBRVS_CCSEQ_NBRVS_BILL_PERIODVS_ACQ_BINVS_CRD_ACC_IDVS_SUPPLIER_NAMEVS_SUPPLIER_CITYVS_SPPLY_STATE_CD
44485000000000001 0108201824639238007900014302110 000000000208000463923948000338000575 SANDIA OFFICE SUPPLY AOPD 505-3414901 NM
44485000000000002 0125201824270748024017858107025 00000000010800142707439300981878357 DH STORM TEAM 610-2688620 PA

<tbody>
</tbody><colgroup><col><col><col><col><col><col><col><col><col><col><col></colgroup>

Detail Sheet
VS_REC_TYPEVS_ACCT_NBRVS_POSTING_DTEVS_CCTRANS_NBRVS_CCSEQ_NBRVS_NO_SHOW_INDVS_CHECK_IN_DATE
44485000000000002 0131201824435658030036006978678 0000000007001282018

<tbody>
</tbody><colgroup><col><col><col><col><col><col><col></colgroup>
 
Upvote 0
See if this works for you. The macro assumes the line terminators in the file are CR LF (the vbCrLf in the code). If incorrect, change this to vbCr or vbLf as needed.

Code: 
Public Sub Load_and_Separate_Credit_Card_File_Data()

    Dim creditCardDataFile As Variant
    Dim fileNum As Integer
    Dim fileData As String
    Dim fileLines As Variant
    Dim fields As Variant
    Dim state As String
    Dim transactionId As String
    Dim destinationWorkbook As Workbook, destinationSheet As Worksheet
    Dim i As Long, r As Long
    
    Set destinationWorkbook = ActiveWorkbook
    
    creditCardDataFile = Application.GetOpenFilename(FileFilter:="All files (*.*),*.*", Title:="Select Credit Card Data File", MultiSelect:=False)
    If creditCardDataFile = False Then
        Exit Sub
    End If
    
    fileNum = FreeFile
    Open creditCardDataFile For Binary As [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fileNum"]#fileNum[/URL] 
    fileData = Space(LOF(fileNum))
    Get [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fileNum"]#fileNum[/URL] , , fileData
    Close [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fileNum"]#fileNum[/URL] 
    
    fileLines = Split(fileData, vbCrLf)
    
    state = ""
    i = 0
    While i < UBound(fileLines)
        fields = Split(fileLines(i), vbTab)
        
        Select Case fields(0)
            Case 6
                state = "fileBegin"
            Case 8
                If state = "fileBegin" Or state = "transactionFooter" Then
                    state = "transactionHeader"
                    transactionId = fields(4)
                End If
            Case 4
                If state = "transactionHeader" Then
                    state = "transaction"
                End If
            Case 9
                If state = "transactionHeader" Or state = "transaction" Then
                    state = "transactionFooter"
                End If
            Case 7
                state = "fileEnd"
        End Select
        
        If state = "transaction" Then
        
            If transactionId = "03" Then
            
                Set destinationSheet = GetSheet(destinationWorkbook, "Employee Data")
                If destinationSheet Is Nothing Then
                    Set destinationSheet = destinationWorkbook.Worksheets.Add(After:=destinationWorkbook.Worksheets(destinationWorkbook.Worksheets.Count))
                    destinationSheet.Name = "Employee Data"
                    destinationSheet.Range("A1:H1").Value = Array("VS_REC_TYPE", "VS_CARDHOLDER_ID", "VS_ACCT_NBR", "VS_HRCHY_NODE", "VS_EFFDT", "VS_ACCT_OPEN_DATE", "VS_ACCT_CLOSE_DATE", "VS_EXPIRE_DATE")
                End If
                r = destinationSheet.Cells(destinationSheet.Rows.Count, "A").End(xlUp).Row + 1
                destinationSheet.Cells(r, "A").Resize(1, UBound(fields) + 1).Value = fields
            
            ElseIf transactionId = "04" Then
                
                Set destinationSheet = GetSheet(destinationWorkbook, "Employee Detail")
                If destinationSheet Is Nothing Then
                    Set destinationSheet = destinationWorkbook.Worksheets.Add(After:=destinationWorkbook.Worksheets(destinationWorkbook.Worksheets.Count))
                    destinationSheet.Name = "Employee Detail"
                    destinationSheet.Range("A1:F1").Value = Array("VS_REC_TYPE", "VS_COMPANY_ID", "VS_CARDHOLDER_ID", "VS_HRCHY_NODE", "VS_FIRST_NAME", "VS_LAST_NAME")
                End If
                r = destinationSheet.Cells(destinationSheet.Rows.Count, "A").End(xlUp).Row + 1
                destinationSheet.Cells(r, "A").Resize(1, UBound(fields) + 1).Value = fields
            
            ElseIf transactionId = "05" Then
                
                Set destinationSheet = GetSheet(destinationWorkbook, "Transactions")
                If destinationSheet Is Nothing Then
                    Set destinationSheet = destinationWorkbook.Worksheets.Add(After:=destinationWorkbook.Worksheets(destinationWorkbook.Worksheets.Count))
                    destinationSheet.Name = "Transactions"
                    destinationSheet.Range("A1:K1").Value = Array("VS_REC_TYPE", "VS_ACCT_NBR", "VS_POSTING_DTE", "VS_CCTRANS_NBR", "VS_CCSEQ_NBR", "VS_BILL_PERIOD", "VS_ACQ_BIN", "VS_CRD_ACC_ID", "VS_SUPPLIER_NAME", "VS_SUPPLIER_CITY", "VS_SPPLY_STATE_CD")
                End If
                r = destinationSheet.Cells(destinationSheet.Rows.Count, "A").End(xlUp).Row + 1
                destinationSheet.Cells(r, "A").Resize(1, 11).Value = fields
            
            ElseIf transactionId = "09" Then
                
                Set destinationSheet = GetSheet(destinationWorkbook, "Detail")
                If destinationSheet Is Nothing Then
                    Set destinationSheet = destinationWorkbook.Worksheets.Add(After:=destinationWorkbook.Worksheets(destinationWorkbook.Worksheets.Count))
                    destinationSheet.Name = "Detail"
                    destinationSheet.Range("A1:G1").Value = Array("VS_REC_TYPE", "VS_ACCT_NBR", "VS_POSTING_DTE", "VS_CCTRANS_NBR", "VS_CCSEQ_NBR", "VS_NO_SHOW_IND", "VS_CHECK_IN_DATE")
                End If
                r = destinationSheet.Cells(destinationSheet.Rows.Count, "A").End(xlUp).Row + 1
                destinationSheet.Cells(r, "A").Resize(1, 7).Value = fields
           
            Else
            
                MsgBox "Unrecognised transaction identifier " & transactionId
                
            End If
                
        End If
        
        i = i + 1
        
    Wend
        
    Set destinationSheet = GetSheet(destinationWorkbook, "Employee Data")
    If Not destinationSheet Is Nothing Then
        destinationSheet.Columns("A:H").AutoFit
    End If
    Set destinationSheet = GetSheet(destinationWorkbook, "Employee Detail")
    If Not destinationSheet Is Nothing Then
        destinationSheet.Columns("A:F").AutoFit
    End If
    Set destinationSheet = GetSheet(destinationWorkbook, "Transactions")
    If Not destinationSheet Is Nothing Then
        destinationSheet.Columns("A:K").AutoFit
    End If
    Set destinationSheet = GetSheet(destinationWorkbook, "Detail")
    If Not destinationSheet Is Nothing Then
        destinationSheet.Columns("A:G").AutoFit
    End If
    
    MsgBox "Done"
    
End Sub


Private Function GetSheet(wb As Workbook, sheetName As String)
    Set GetSheet = Nothing
    On Error Resume Next
    Set GetSheet = wb.Worksheets(sheetName)
    On Error GoTo 0
End Function
The code outputs the data to the active workbook, which means if you open a 2nd workbook and run the macro from that workbook the data will be put in that workbook, otherwise the data will put in the macro workbook. The sheets are created if they don't exist.
 
Last edited:
Upvote 0
:( I tried your code in an blank workbook and also one with the sheets named as previous mentioned and the file was not copied. Any suggestions or thoughts?
 
Upvote 0
The macro doesn't copy any files. It imports data from the file selected by you via the "Select Credit Card Data File" dialogue. Did it display the "Done" message at the end?

I would need the real data file (with anonymised data) in order to debug the code and see why it doesn't work for you.
 
Upvote 0
Yes sorry I misspoke. The file data is not being placed in the spreadsheets. It did display the Done message. Is there a way I can send a dummy file to you to help debug?
 
Upvote 0
Please upload the file to a file sharing site and post the link here or send it to me in a private message.

But before that, see if this new version of the macro imports the data correctly. I suspect the first version didn't import any data because it expects the record (line) separators to be CR LF characters (ASCII 13 followed by ASCII 10). The new version below tries different record separators CR LF, CR and LF, and if none of these are correct it displays an error message. The parser is also simpler.

This new macro completely replaces the previous code.

Code: 
Public Sub Load_and_Separate_Credit_Card_File_Data_V2()

    Dim creditCardDataFile As Variant
    Dim fileNum As Integer
    Dim fileData As String
    Dim fileLines As Variant
    Dim fields As Variant
    Dim transactionId As String
    Dim destinationWorkbook As Workbook
    Dim EmployeeDataSheet As Worksheet, EmployeeDetailSheet As Worksheet, TransactionsSheet As Worksheet, DetailSheet As Worksheet
    Dim i As Long, r As Long
    
    Set destinationWorkbook = ActiveWorkbook
    
    creditCardDataFile = Application.GetOpenFilename(FileFilter:="All files (*.*),*.*", Title:="Select Credit Card Data File", MultiSelect:=False)
    If creditCardDataFile = False Then
        Exit Sub
    End If
    
    fileNum = FreeFile
    Open creditCardDataFile For Binary As [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fileNum"]#fileNum[/URL] 
    fileData = Space(LOF(fileNum))
    Get [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fileNum"]#fileNum[/URL] , , fileData
    Close [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=fileNum"]#fileNum[/URL] 
    
    fileLines = Split(fileData, vbCrLf)
    If UBound(fileLines) = 0 Then fileLines = Split(fileData, vbCr)
    If UBound(fileLines) = 0 Then fileLines = Split(fileData, vbLf)
    If UBound(fileLines) = 0 Then
        MsgBox "Error: unable to determine the record separator in " & creditCardDataFile, vbExclamation
        Exit Sub
    End If
    
    Set EmployeeDataSheet = GetSheet(destinationWorkbook, "Employee Data")
    If EmployeeDataSheet Is Nothing Then
        Set EmployeeDataSheet = destinationWorkbook.Worksheets.Add(After:=destinationWorkbook.Worksheets(destinationWorkbook.Worksheets.Count))
        EmployeeDataSheet.Name = "Employee Data"
        EmployeeDataSheet.Range("A1:H1").Value = Array("VS_REC_TYPE", "VS_CARDHOLDER_ID", "VS_ACCT_NBR", "VS_HRCHY_NODE", "VS_EFFDT", "VS_ACCT_OPEN_DATE", "VS_ACCT_CLOSE_DATE", "VS_EXPIRE_DATE")
    End If
    
    Set EmployeeDetailSheet = GetSheet(destinationWorkbook, "Employee Detail")
    If EmployeeDetailSheet Is Nothing Then
        Set EmployeeDetailSheet = destinationWorkbook.Worksheets.Add(After:=destinationWorkbook.Worksheets(destinationWorkbook.Worksheets.Count))
        EmployeeDetailSheet.Name = "Employee Detail"
        EmployeeDetailSheet.Range("A1:F1").Value = Array("VS_REC_TYPE", "VS_COMPANY_ID", "VS_CARDHOLDER_ID", "VS_HRCHY_NODE", "VS_FIRST_NAME", "VS_LAST_NAME")
    End If

    Set TransactionsSheet = GetSheet(destinationWorkbook, "Transactions")
    If TransactionsSheet Is Nothing Then
        Set TransactionsSheet = destinationWorkbook.Worksheets.Add(After:=destinationWorkbook.Worksheets(destinationWorkbook.Worksheets.Count))
        TransactionsSheet.Name = "Transactions"
        TransactionsSheet.Range("A1:K1").Value = Array("VS_REC_TYPE", "VS_ACCT_NBR", "VS_POSTING_DTE", "VS_CCTRANS_NBR", "VS_CCSEQ_NBR", "VS_BILL_PERIOD", "VS_ACQ_BIN", "VS_CRD_ACC_ID", "VS_SUPPLIER_NAME", "VS_SUPPLIER_CITY", "VS_SPPLY_STATE_CD")
    End If
    
    Set DetailSheet = GetSheet(destinationWorkbook, "Detail")
    If DetailSheet Is Nothing Then
        Set DetailSheet = destinationWorkbook.Worksheets.Add(After:=destinationWorkbook.Worksheets(destinationWorkbook.Worksheets.Count))
        DetailSheet.Name = "Detail"
        DetailSheet.Range("A1:G1").Value = Array("VS_REC_TYPE", "VS_ACCT_NBR", "VS_POSTING_DTE", "VS_CCTRANS_NBR", "VS_CCSEQ_NBR", "VS_NO_SHOW_IND", "VS_CHECK_IN_DATE")
    End If
    
    i = 0
    While i < UBound(fileLines)
        fields = Split(fileLines(i), vbTab)
        
        Select Case fields(0)  '1st column
        
            Case 8
            
                transactionId = fields(4) '5th column
                
            Case 4
        
                 If transactionId = "03" Then
                     r = EmployeeDataSheet.Cells(EmployeeDataSheet.Rows.Count, "A").End(xlUp).Row + 1
                     EmployeeDataSheet.Cells(r, "A").Resize(1, UBound(fields) + 1).Value = fields
                 ElseIf transactionId = "04" Then
                     r = EmployeeDetailSheet.Cells(EmployeeDetailSheet.Rows.Count, "A").End(xlUp).Row + 1
                     EmployeeDetailSheet.Cells(r, "A").Resize(1, UBound(fields) + 1).Value = fields
                 ElseIf transactionId = "05" Then
                     r = TransactionsSheet.Cells(TransactionsSheet.Rows.Count, "A").End(xlUp).Row + 1
                     TransactionsSheet.Cells(r, "A").Resize(1, 11).Value = fields
                 ElseIf transactionId = "09" Then
                     r = DetailSheet.Cells(DetailSheet.Rows.Count, "A").End(xlUp).Row + 1
                     DetailSheet.Cells(r, "A").Resize(1, 7).Value = fields
                 Else
                     MsgBox "Unrecognised transaction identifier " & transactionId & " in line number " & i + 1 & vbCrLf & _
                            fileLines(i)
                 End If
                
        End Select
        
        i = i + 1
        
    Wend
        
    EmployeeDataSheet.Columns("A:H").AutoFit
    EmployeeDetailSheet.Columns("A:F").AutoFit
    TransactionsSheet.Columns("A:K").AutoFit
    DetailSheet.Columns("A:G").AutoFit
    
    MsgBox "Done"
    
End Sub


Private Function GetSheet(wb As Workbook, sheetName As String)
    Set GetSheet = Nothing
    On Error Resume Next
    Set GetSheet = wb.Worksheets(sheetName)
    On Error GoTo 0
End Function
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
import folder and subfolder & files based on last modified date into each sheet and open
Replies
1
Views
428
abdelfattah
A

Forum statistics

Threads
1,214,788
Messages
6,121,597
Members
449,038
Latest member
Arbind kumar

Share this page

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
Back
Top