Question

I need to extract data (the 'TOTAL TRAVEL (ALLOWANCES & AIRFARES & Car Hire)' aka sMarker5 to be exact) from all the .txt files from a directory, and my current code will work for amount less than $1,000 for the line. I am guessing it's because files with >$1,000 against this line is always after a carriage return. So my question is... how should I modify my code so that it will work for any amount?

My next question is... I also need to extract data for 'Car Hire', however, the term 'Car Hire' appears various times (not a constant T_T) before the one I actually wanted ('Car Hire $#.##', located near the end of the .txt file)... is there a way I can achieve that with my code?

Thanks heaps in advance!!!


Sub AddTrs2()

'Another sub
ClearAll

Dim MyFolder As String
MyFolder = "Z:\fin1\data\FIN118P\import\Travel\TRs\"
Sep = Application.PathSeparator

If Sep = "\" Then
    F = Dir(MyFolder & Sep & "*.txt")
End If

Range("A2").Select

Do While Len(F) > 0
    ActiveCell.Formula = MyFolder & F
    ActiveCell.Offset(1, 0).Select
    noLines = noLines + 1
    F = Dir()
Loop

Range("A2").Select

GrabData
'Invoke the sub "GrabData"

End Sub

Sub GrabData()

Const sMarker1 = "Total Accommodation"
Const sMarker2 = "INCIDENTAL ALLOWANCE"
Const sMarker3 = "TA & EXCESS COSTS"
Const sMarker4 = "Travel Tax"
Const sMarker5 = "TOTAL TRAVEL (ALLOWANCES & AIRFARES & Car Hire)"
Const sMarker6 = "Non ACMA Traveller Name:"
Const sMarker7 = "Excess Costs "

Dim text As String
Dim textline As String
Dim TrvReqs As Long
Dim Incidental As Long
Dim TotalAccom As Long
Dim TAExcess As Long
Dim TravelTax As Long
Dim TOTALTRAVEL As Long
Dim NonACMA As String
Dim ExcessCosts As Long
Dim i As Long, oRng As Range

Set oRng = Range("A1")
For i = 1 To noLines
    text = ""
    'Reset the text to blank

    Open oRng.Offset(i, 0).Value For Input As #1
    Do Until EOF(1)
        Line Input #1, textline
        text = text & textline
    Loop

    Close #1

    'Get location of text after sMarker
    TotalAccom = InStr(text, sMarker1) + Len(sMarker1) + 2
    Incidental = InStr(text, sMarker2) + Len(sMarker2) + 2
    TAExcess = InStr(text, sMarker3) + Len(sMarker3) + 2
    TravelTax = InStr(text, sMarker4) + Len(sMarker4) + 2
    TOTALTRAVEL = InStr(text, sMarker5) + Len(sMarker5) + 2
    TrvReqs = Left(Right(oRng.Offset(i, 0).Value, 10), 6)
    NonACMA = InStr(text, sMarker6) + Len(sMarker6)
    ExcessCosts = InStr(text, sMarker7) + Len(sMarker7) + 2

    'Store 6 characters of text after sMarker to Columns
    oRng.Offset(i, 1).Value = TrvReqs
    oRng.Offset(i, 2).Value = Mid(text, TotalAccom, 6)
    oRng.Offset(i, 3).Value = Mid(text, Incidental, 6)
    oRng.Offset(i, 5).Value = Mid(text, TAExcess, 6)
    oRng.Offset(i, 6).Value = Mid(text, TravelTax, 6)
    oRng.Offset(i, 7).Value = Mid(text, TOTALTRAVEL, 6)
    oRng.Offset(i, 8).Value = Mid(text, ExcessCosts, 100)
    oRng.Offset(i, 11).Value = Mid(text, NonACMA, 30)
Next i
Set oRng = Nothing

'Another sub
ClearNonNumeric

Range("A1").Select

End Sub

UPDATE:

I tried to apply David's code to another problem: to capture the line "TOTAL TRAVEL (ALLOWANCES & AIRFARES & Car Hire)" that sometimes have the dollar value after a return (see code above, it works for lines without the return - i.e. dollar amount less than $1,000). However, after I modified the code with David's suggestion... I get a Run-time error '5': Invalid procedure call or argument against the TOTALTRAVEL = InStrRev(text, sMarker5, endParse) line...

I am not sure what I done wrong...


Sub GrabData()

Const sMarker1 = "Total Accommodation"
Const sMarker2 = "INCIDENTAL ALLOWANCE"
Const sMarker3 = "TA & EXCESS COSTS"
Const sMarker4 = "Travel Tax"

'New line
Const sMarker5 As String = "TOTAL TRAVEL (ALLOWANCES & AIRFARES & Car Hire)"

Const sMarker6 = "Non ACMA Traveller Name:"
Const sMarker7 = "Excess Costs "
Const sMarker8 = "Car Hire "

'New line
Const sTerminate As String = "AccommodationNightsPrice/NightTotal"

Dim text As String
Dim textline As String
Dim TrvReqs As Long
Dim Incidental As Long
Dim TotalAccom As Long
Dim TAExcess As Long
Dim TravelTax As Long
Dim TOTALTRAVEL As Long
Dim NonACMA As String
Dim ExcessCosts As Long
Dim CarHire As Long

'New line
Dim endParse As Long

Dim i As Long, oRng As Range

'New line
endParse = InStr(1, text, sTerminate)

Set oRng = Range("A1")
For i = 1 To noLines
    text = ""
    Open oRng.Offset(i, 0).Value For Input As #1
    Do Until EOF(1)
        Line Input #1, textline
        text = text & textline
    Loop

    Close #1

    TotalAccom = InStr(text, sMarker1) + Len(sMarker1) + 2
    Incidental = InStr(text, sMarker2) + Len(sMarker2) + 2
    TAExcess = InStr(text, sMarker3) + Len(sMarker3) + 2
    TravelTax = InStr(text, sMarker4) + Len(sMarker4) + 2

    'New line        
    TOTALTRAVEL = InStrRev(text, sMarker5, endParse)

    TrvReqs = Left(Right(oRng.Offset(i, 0).Value, 10), 6)
    NonACMA = InStr(text, sMarker6) + Len(sMarker6)
    ExcessCosts = InStr(text, sMarker7) + Len(sMarker7) + 2
    CarHire = InStrRev(text, sMarker8) + Len(sMarker8)

    oRng.Offset(i, 1).Value = TrvReqs
    oRng.Offset(i, 2).Value = Mid(text, TotalAccom, 6)
    oRng.Offset(i, 3).Value = Mid(text, Incidental, 6)
    oRng.Offset(i, 4).Value = Mid(text, CarHire, 7)
    oRng.Offset(i, 5).Value = Mid(text, TAExcess, 6)
    oRng.Offset(i, 6).Value = Mid(text, TravelTax, 6)

    'New line
     oRng.Offset(i, 7).Value = Replace(Trim(Mid(text, TOTALTRAVEL, (endParse - TOTALTRAVEL))sMarker5, vbNullString))

    oRng.Offset(i, 8).Value = Mid(text, ExcessCosts, 100)
    oRng.Offset(i, 11).Value = Mid(text, NonACMA, 30)
Next i
Set oRng = Nothing

ClearNonNumeric

Range("A1").Select

End Sub
Was it helpful?

Solution

I think you need the second to last occurrence of Car Hire.

Try this:

Add some new constants in your GrabData routine.

Const sMarker8 As String = "Car Hire"
'This is what comes AFTER "Car Hire". It only appears once in the example file
Const sTerminate As String = "PDTA (Payable via salary)"  

Then, you can compute the position of your Car Hire using those two strings:

'Find out what comes AFTER "Car Hire"
endParse = InStr(1, text, sTerminate)
'Now, work backwards from that position to find the first instance of "Car Hire" 
' that appears *before* the sTerminate string.
CarHire = InStrRev(text, sMarker8, endParse)

Then, using Mid and Replace, you can pull out the numeric portion for Car Hire:

oRng.Offset(1, 12).Value = Replace( _
        Trim(Mid(text, CarHire, endParse - CarHire), sMarker8, vbNullString))

In the example file, this returns $0.00

I think this should work even if the dollar amount is separated by a carriage return.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top