Excel or VBA to convert unstructured text to column - excel

Question

How can I convert text to column when the text is unstructured with no proper delimiters.
For example, how can i turn the following lines:
Into something like:
In Excel the Text to columns don't seem to find the right separator (space, tab,...). I tried in VBA with the following:
I1 = Mid(Cells(i, 1), 1, 16)
I2 = Mid(Cells(i, 1), 17, 33)
I3 = Mid(Cells(i, 1), 34, 49)
I4 = Mid(Cells(i, 1), 50, 53)
I5 = Mid(Cells(i, 1), 54, 66)
I6 = Mid(Cells(i, 1), 67, 82)
I7 = Mid(Cells(i, 1), 83, 99)
I8 = Mid(Cells(i, 1), 100, 116)
I9 = Mid(Cells(i, 1), 117, 133)
But I get it doesn't work for all columns. For example, for I3 I get many more values that expected like:
I tried also replacing the tab (in case it existed) like:
MyString = Replace(MyString, vbTab, "")
But didn't work either.
Is there another way to approach it?

Answer 1

Here is an attempt using a custom ReplaceWhitespace function, which replaces sections of whitespace in turn depending on their length. As an intermediate step whitespace is replaced with semicolons; unnecessary semicolons are removed as a last step. Split is used to read the parsed string to an array, and the array is used to read the result to the worksheet. It should be straightforward to tweak ReplaceWhitespace for your specific needs.
Note that this algorithm does not evaluate whether instances of a single whitespace character should be treated as noise (as in "TUBELINES UNASSIGNED") or ar as valid word delimter (as in "Unit Cost"). Therefore, single whitespace as noise is treated as special cases in ReplaceWhitespace: "- -" ~~> "-;-" and " UNASSIGNED " ~~> ";UNASSIGNED;"
Assuming your data from the screenshot is located in range A1:A4, this code produces more or less the desired output, as shown in the screenshot below.
EDIT: The initial design of ReplaceWhitespace was based on trial and error. With a little afterthought I realized that patterns where the number of whitespace characters or semicolons is a composite number will be taken care of by those lines in the algorithm that looks for patterns where the number of characters is a prime number. I have updated the code accordingly.
Sub ParseUnstructured()
Dim i As Long
For Each cell In Range("A1:A4")
i = i + 1
' Clean whitespace:
sRow = ReplaceWhitespace(cell.Value)
' Read to array
Dim sArray() As String
sArray() = Split(sRow, ";")
' Read to worksheet:
Range("A1").Offset(5 + i).Resize(1, UBound(sArray)+1).Value = sArray
Next cell
End Sub
Function ReplaceWhitespace(sInput As String) As String
Dim sOutput As String
' Look for special cases with single-whitespace noise:
sOutput = Replace(sInput, "- -", "-;-") ' Take care of "----- ----"
sOutput = Replace(sOutput, "UNASSIGNED", ";UNASSIGNED;")
' Look for patterns where the number of "noise" characters is a prime number:
sOutput = Replace(sOutput, " ", ";") ' 7 whitespaces
sOutput = Replace(sOutput, " ", ";") ' 5
sOutput = Replace(sOutput, " ", ";") ' 3
sOutput = Replace(sOutput, " ", ";") ' 2
' sOutput = Replace(sOutput, " ", "_") ' 1 Optional
sOutput = Replace(sOutput, ";;;;;", ";") ' 5 semicolons
sOutput = Replace(sOutput, ";;;", ";") ' 3
sOutput = Replace(sOutput, ";;", ";") ' 2
sOutput = Replace(sOutput, "; ", ";") ' Takes care of some leftovers.
ReplaceWhitespace = sOutput
End Function
Result from running ParseUnstructured():

Answer 2

The data you present does have a regular pattern, assuming that the Category can only be one of a few defined words.
One could also assume that UOM has only a few defined words, if Category will only ever be a single word. For example
Item: First substring followed by a space
Description: Variable number of words followed by Category
Category: From list of defined words
UOM: From list of defined words
And then the remainder are all space separated.
From that pattern, we can construct a Regular Expression, and use that in a VBA macro to split the line.
Of course, if the pattern varies from that, the method won't work. But you'll have to provide examples which encompass all of the variability.
The macro below assumes that Category will be either ASSIGNED or UNASSIGNED, but you can add more words to the pipe-separated list in the code.
Other assumptions are in the code.
Option Explicit
Sub parseLine()
Dim WS As Worksheet, R As Range, C As Range
Dim RE As Object, MC As Object
Dim vRes As Variant, I As Long
'Set original worksheet/range
'change to suit
'Below uses column A
Set WS = Worksheets("sheet1")
With WS
Set R = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
'Initialize regex engine
Set RE = CreateObject("vbscript.regexp")
With RE
.Pattern = "^(\S+)\s+(.*)\s*\b(UNASSIGNED|ASSIGNED)\b\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)"
.IgnoreCase = False
.MultiLine = True
.Global = True
End With
'Iterate through; create the Parse line and parse
Application.ScreenUpdating = False
For Each C In R
If RE.Test(C.Text) = True Then
Set MC = RE.Execute(C.Text)
ReDim vRes(1 To MC(0).SubMatches.Count)
For I = 1 To UBound(vRes)
vRes(I) = MC(0).SubMatches(I - 1)
Next I
'write the results next to the column)
With C.Offset(0, 1).Resize(columnsize:=UBound(vRes))
.Clear
.NumberFormat = "#"
.Value = vRes
.EntireColumn.AutoFit
End With
End If
Next C
Application.ScreenUpdating = True
End Sub