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

[malfisint1]

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

 

[malfisint1]

It looks like it worked!! YAY!! Just a few things though, the Detail sheet was the only sheet that wrote the column names. What would you suggest in order to clear the data in order to load a new file?

 

[John_w]

The macro adds each sheet with column headings if it doesn't exist, so simply delete the 4 sheets in the output workbook before running the macro.

 

[malfisint1]

This works like a charm!! You are amazing!! Any suggestions on code on how to clear the data in order to load a new file?

 

[John_w]

Thanks - I'm glad it works!

This version of the macro adds a new output sheet with column headings if the sheet doesn't exist, otherwise it clears existing data rows.

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
    
    'For each of the 4 output sheets, add a new sheet with column headings if it doesn't exist, otherwise clear existing data rows
    
    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")
    Else
        EmployeeDataSheet.UsedRange.Offset(1).Clear
    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")
    Else
        EmployeeDetailSheet.UsedRange.Offset(1).Clear
    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")
    Else
        TransactionsSheet.UsedRange.Offset(1).Clear
    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")
    Else
        DetailSheet.UsedRange.Offset(1).Clear
    End If
    
    i = 0
    While i < UBound(fileLines)
        fields = Split(fileLines(i), vbTab)
        
        Debug.Print fileLines(i)
        Debug.Print "id "; fields(0)
        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

 

[malfisint1]

This worked beautifully and gave me more understanding of VBA!! Thank you so much!! ray: