Revise the following procedure's 'Setup header row block of code if you want to
freeze the headers.


Sub Parse_TxtFileBlockData()
Const sSrc$ = "Parse_TxtFileBlockData" '//AppMode.CallerID

Dim vData, vTmp, v
Dim lRow&, n&, k&, sFile$, sVPD$, sTag$, sFields$
sVPD = " = ": sTag = "~": sFields =
"Location,StoreID,StockID,Address,XroadID,ID"

'Setup header row
lRow = 1: vTmp = Split(sFields, ",")
Cells(lRow, 1).Resize(1, UBound(vTmp) + 1) = vTmp
Application.Goto (Cells(2, 1))
CommandBars(1).Controls("Window").Controls("&Freez e Panes").Execute

'Get the filename
sFile = Application.GetOpenFilename
If sFile = "" Then Beep: Exit Sub

'Load the file into an array of data blocks
vData = Split(ReadTextFile(sFile), "Location = ")

EnableFastCode sSrc
'Parse the data into useable bits
For n = LBound(vData) To UBound(vData)
'Parse each data block into an array
If Not vData(n) = "" Then
vTmp = Split(vData(n), vbCrLf)
For k = LBound(vTmp) To UBound(vTmp)

'Strip out unwanted data from Location
If k = 0 Then
'Remove quote characters
vTmp(k) = Replace(vTmp(k), Chr(34), "")
'Remove state
v = Split(vTmp(k), Chr(32)) '//format is "city<spacestate"
v(UBound(v)) = sTag: vTmp(k) = Join(Filter(v, sTag, False),
Chr(32))
End If 'k = 0

'Strip out unwanted data from other fields
If vTmp(k) = "" Then '//tag blank lines
vTmp(k) = sTag
Else '//parse value pairs
If InStr(vTmp(k), sVPD) 0 Then vTmp(k) = Split(vTmp(k), sVPD)(1)
End If 'vTmp(k) = ""
Next 'k
vTmp = Filter(vTmp, sTag, False) '//remove tagged elements

'Dump the data into next empty row
lRow = lRow + 1
Cells(lRow, 1).Resize(1, UBound(vTmp) + 1) = vTmp
End If 'Not vData(n) = ""
Next 'n
EnableFastCode sSrc, False

End Sub 'Parse_TxtFileBlockData

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion