Parsing a string, similar to Text to Columns

[dbell55]

I aSpacem trying to create a tool or a simple VBA Macro to parse a data string, as Text to Columns does, but:
1. With several (3) different delimiters, used sequentially
2. Only on the first occurrence of each delimiter
3. For all cells in the column, until a Blank

Say A2 contains the source string "PmxXU3: MAX(abs(V(NU1+)*Ix(U3:In+)+V(REF_LVL)*Ix(U3:In-)=1.07979 FROM 0 TO 0.7"

After executing,,
B2 contains "PmxXU3" << Parses on ":" (colon)
C2 contains "MAX(abs(V(NU1+)*Ix(U3:In+)+V(REF_LVL)*Ix(U3:In-)" << Parses "=" (equals), ignoring further occurrences of ":"
D2 contains "1.07979" << Parses on first occurrence of Space
E2 contains "FROM 0 TO 0.7" << Remainder of A2 string

Repeats on A3 and the rest of column A

Thanks for suggestions!
Dave

 

[hungtbatman1]

1. Do they delimiters always appear in the order ":", "=", " "? Because if it can be in the order e.g. ":", " ", "=" then after finding ":" after PmxXU3, between ":" and "MAX" there is a space " " and C2 = "",
D2 = "MAX(abs(V(NU1+)*Ix(U3:In+)+V(REF_LVL)*Ix(U3:In-)"
and E2 = "1.07979 FROM 0 TO 0.7"

2. Do ":", "=", " " always occur? Because if not and we only have e.g. "=", " " then:
B2 = A2, C2 = D2 = E2 = ""???

Can it be any different?

The code below was written with the assumptions:
1. The code always searches for delimiters in the order ":", "=", " "

2. If a delimiter does not occur then the text A2 will be divided by the remaining delimiters. For example if in A2 we delete all ":", then:
B2 = "PmxXU3 MAX(abs(V(NU1+)*Ix(U3In+)+V(REF_LVL)*Ix(U3In-)"
C2 = "1.07979"
D2 = "FROM 0 TO 0.7"

If you do not accept these assumptions then do not read further because the code is not for you.

Sub split_text()
Dim lastRow As Long, i As Long, k As Long, col As Long, pos As Long, delimiters As String, text As String, data()
    delimiters = ":= "
    With Worksheets("Sheet1")
        .Range("B2:E10000").ClearContents       '   Delete old results
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        If lastRow < 2 Then Exit Sub    ' no data
        data = .Range("A2:A" & lastRow + 1).Value
        ReDim Preserve data(1 To UBound(data, 1), 1 To 4)
        For i = 1 To UBound(data, 1) - 1
            text = data(i, 1)
            col = 0
            For k = 1 To 3
                pos = InStr(1, text, Mid(delimiters, k, 1))
                If pos Then
                    col = col + 1
                    data(i, col) = Mid(text, 1, pos - 1)
                    text = Trim(Mid(text, pos + 1))
                End If
            Next k
            col = col + 1
            data(i, col) = text
        Next i
        .Range("B2:E2").Resize(UBound(data, 1) - 1).Value = data
    End With
End Sub

 

[dbell55]

Thanks, hungbatman1 - this works perfectly!
All of your assumptions are valid; the data structure is pretty consistent.

I can't find a Mark as Solution button, though!

Dave

 

[Fuji]

Simply...

Sub test()
    Dim a, x, i&
    With Range("a2", Range("a" & Rows.Count).End(xlUp)).Resize(, 5)
        .Offset(, 1).Resize(, 4).ClearContents
        a = .Value
        For i = 1 To UBound(a, 1)
            If a(i, 1) Like "*:*=* *" Then
                x = Split(a(i, 1), ":", 2): a(i, 2) = x(0)
                x = Split(Trim$(x(1)), "="): a(i, 3) = x(0)
                x = Split(x(1), " ", 2)
                a(i, 4) = x(0): a(i, 5) = x(1)
            End If
        Next
        .Value = a
    End With
End Sub

 

[dbell55]

Simply...

Sub test()
    Dim a, x, i&
    With Range("a2", Range("a" & Rows.Count).End(xlUp)).Resize(, 5)
        .Offset(, 1).Resize(, 4).ClearContents
        a = .Value
        For i = 1 To UBound(a, 1)
            If a(i, 1) Like "*:*=* *" Then
                x = Split(a(i, 1), ":", 2): a(i, 2) = x(0)
                x = Split(Trim$(x(1)), "="): a(i, 3) = x(0)
                x = Split(x(1), " ", 2)
                a(i, 4) = x(0): a(i, 5) = x(1)
            End If
        Next
        .Value = a
    End With
End Sub

Dōmo arigatō, Fuji!
This is another perfect macro. I do like the use of Split(), making the code very easy to understand.
Dave

 

[Fuji]

You are welcome and glad if you like it.

 

[Peter_SSs]

Welcome to the MrExcel board!

Here is another option that you could try. I have assumed that third extracted column will be numerical but that could be adjusted if not always the case.

Sub TTC()
  With Range("B2:E" & Range("A2").End(xlDown).Row)
    .ClearContents
    .Value = Evaluate(Replace("let(a,#,b,textbefore(a,"":""),c,trim(textbefore(textafter(a,"":""),""="")),d,--textbefore(textafter(a,""=""),"" ""),e,trim(textafter(a,d)),hstack(b,c,d,e))", "#", .Columns(0).Address))
    .Columns.AutoFit
  End With
End Sub