convert string to columns

[Dave A]

Hi,

I have txt file with many lines of text with variable length of data.
The information of interest is literally contained with quotation marks
within a string.

I wish to;

a) Extract all text within the string in quotation marks and convert to
columns
b) Ignore any quotation marks that have null information
c) Ignore any repeats.

Example below

g.l="0",B="1234"&"1234"&"1234",B="",NAM="FISH"&"CHIPS",U=,NBR="3";


outcome

Col A Col B Col C Col D Col E
0 1234 FISH CHIPS 3


Cheers
Dave

 

[NickHK]

Dave,
Not perfect, but it should give you some ideas:

Private Sub CommandButton1_Click()
Dim ConnStr As String
Dim QT As QueryTable
Dim CellVal As Range

ConnStr = "TEXT;C:\Document1.txt"
Set QT = ActiveSheet.QueryTables.Add(Connection:=ConnStr,
Destination:=Range("A1"))
With QT
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
'Split fields on ","
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
'Split fields on "="
.TextFileOtherDelimiter = "="
'Ignore the field indictors e.g. g.l, B ,B ,NAM etc
'With all other fields imported as text
.TextFileColumnDataTypes = Array(9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2)
.Refresh BackgroundQuery:=False
End With

For Each CellVal In Range(QT.Name)
CellVal.Select
If InStr(1, CellVal.Value, "&") > 0 Then CellVal.Value =
RemoveDupeData(CellVal.Value)
Next

For Each CellVal In Range(QT.Name)
CellVal.Select
If CellVal.Value = "" Then CellVal.Delete xlShiftToLeft
Next

End Sub


Private Function RemoveDupeData(argInputStr As String) As String
Dim TempStr As String
Dim arr As Variant

'Remove extra quote marks
TempStr = Replace(argInputStr, Chr(34), "")
'Split on the "&"
arr = Split(TempStr, "&")
'See if the first 2 element are the same
If arr(0) = arr(1) Then
'Yes, so use the first element
RemoveDupeData = arr(0)
Else
'No so join all togeter in a sentence
RemoveDupeData = Join(arr, " ")
End If

End Function