Problem importing a txt file

[Jerry]

I'm using Chip Pearson's routine to import a txt file into Excel using
VBA (see below). This works like a charm as long as the data in the
textfile start on the first row. Problem is that I first have a number
of lines in the textfile with some descriptive text in it. How would I
adapt Chip's code to start importing from a certain line number in the
txt file? What might be helpful is the fact that the last line before
the actual delimited data always starts with "item". I have attached a
sample for your review below. As ever, your help is much appreciated.

regards,
Jerry

Chip's code (taken from http://www.cpearson.com/excel/imptext.htm):

Public Sub ImportTextFile(FName As String, Sep As String)

Dim RowNdx As Integer
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer

Application.ScreenUpdating = False
'On Error GoTo EndMacro:

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.row

Open FName For Input Access Read As #1

While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1

End Sub


------------Sample text file----------------

Report jan 2004
Generated by Jerry

Items_in_Report
01, 02, 03, 04, 05, 06, 07, 08, 09, 10, 11, 12, 13, 14, 15, 16, 17,
18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34,
35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49

Layer Translation
item price client
1 56 f.g.
2 87 t.y.
3 987 s.l.
etc.

 

[mudraker]

Jerry

one way Changes shown in Red


Dim RowNdx As Integer
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer
dim SkipRow as Integer

Application.ScreenUpdating = False
'On Error GoTo EndMacro:

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.row
SkipRow = 9

Open FName For Input Access Read As #1

While Not EOF(1)
Line Input #1, WholeLine
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos >= 1

if RowNdx > SkipRow then
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx-SkipRow, ColNdx).Value = TempVal
end if

Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
Wend

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1

End Su

 

[biotek]

Thanks for your help Mudraker. Your changes in the code work as long a
there are 9 lines of descriptive text above the actual tab-delimite
data. However, the number of lines above the data is not always
(apologies for not mentioning that earlier). Ideally, the code shoul
search for the string "item" and importing data from the next line on
I hope you can help me getting this to work.

thanks for your help,
Jerr

 

[Dave Peterson]

One way:

Option Explicit

Public Sub ImportTextFile(FName As String, Sep As String)

Dim RowNdx As Integer
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer
Dim StartKeeping As Boolean

Application.ScreenUpdating = False
'On Error GoTo EndMacro:

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row

Open FName For Input Access Read As #1

StartKeeping = False
While Not EOF(1)
Line Input #1, WholeLine
If StrComp(Left(WholeLine, 4), "item", vbTextCompare) = 0 Then
StartKeeping = True
Else
If StartKeeping = True Then
If Right(WholeLine, 1) <> Sep Then
WholeLine = WholeLine & Sep
End If
ColNdx = SaveColNdx
Pos = 1
NextPos = InStr(Pos, WholeLine, Sep)
While NextPos >= 1
TempVal = Mid(WholeLine, Pos, NextPos - Pos)
Cells(RowNdx, ColNdx).Value = TempVal
Pos = NextPos + 1
ColNdx = ColNdx + 1
NextPos = InStr(Pos, WholeLine, Sep)
Wend
RowNdx = RowNdx + 1
End If
End If
Wend

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #1
End Sub