View Single Post
  #4   Report Post  
Old December 31st 18, 11:50 PM posted to microsoft.public.excel.programming
GS[_6_] GS[_6_] is offline
external usenet poster
First recorded activity by ExcelBanter: Apr 2015
Posts: 1,015
Default covert data from text file into columns

You didn't confirm/deny stripping of the state from Location so I included
that; - comment it out if not using.
Paste this into a new module and let me know how things go...

'<begin code
Option Explicit

'[EnableFastCode() Type Declarations]
Type udtAppModes
'Default types
Events As Boolean: CalcMode As XlCalculation: Display As Boolean: CallerID As
'Project-specific types
End Type
Public AppMode As udtAppModes

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

Dim vData, vTmp, v
Dim lRow&, n&, k&, sFile$, sVPD$, sTag$, sFields$
sVPD = " = ": sTag = "~": sFields =

'Setup header row
lRow = 1: vTmp = Split(sFields, ",")
Cells(lRow, 1).Resize(1, UBound(vTmp) + 1) = vTmp

'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

Function ReadTextFile$(Filename$)
' Reads large amounts of data from a text file in a single step.
Dim iNum%
On Error GoTo ErrHandler
iNum = FreeFile(): Open Filename For Input As #iNum
ReadTextFile = Space$(LOF(iNum))
ReadTextFile = Input(LOF(iNum), iNum) '//return the entire file

Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Function 'ReadTextFile()

' **Note: EnableFastCode requires the following declarations be in a standard
'[EnableFastCode() Type Declarations]
'Type udtAppModes
' 'Default types
' Events As Boolean: CalcMode As XlCalculation: Display As Boolean: CallerID
As String
' 'Project-specific types
'End Type
'Public AppMode As udtAppModes
Sub EnableFastCode(Caller$, Optional SetFast As Boolean = True)
' **Note: Requires 'Type udtAppModes' and 'Public AppMode As udtAppModes'

'The following will make sure only the Caller has control,
'and allows any Caller to take control when not in use.
If AppMode.CallerID < Caller Then _
If AppMode.CallerID < "" Then Exit Sub

With Application
If SetFast Then
AppMode.Display = .ScreenUpdating: .ScreenUpdating = False
AppMode.CalcMode = .Calculation: .Calculation = xlCalculationManual
AppMode.Events = .EnableEvents: .EnableEvents = False
AppMode.CallerID = Caller
.ScreenUpdating = AppMode.Display
.Calculation = AppMode.CalcMode
.EnableEvents = AppMode.Events
AppMode.CallerID = ""
End If
End With
End Sub 'EnableFastCode()


Free usenet access at
Classic VB Users Regroup!