Help with Split Function

[swaggerbox]

The code below will return the output:

red 10-16
aconite 13-17
suberect spatholobus stem 5-15
tianxiong 12-18
ligusticum striatum 2-4
celastreae 25-35
maca 10-18
eucommia bark 18-22
fennel 10-20
radix paeoniae alba 3-5
raw rheum officinale 10-18
honeysuckle 10-20
rhizoma arisaematis 10-20
radix astragali 4-8
talc 5-16
asarum 2-4
notopterygium root 16-20
dried orange peel 8-25
radix codonopsitis 2-6
root of kudzu vine 10-20
pangolin 17-23
rehmannia glutinosa 8-25
ground beeltle 11-15
semen brassicae 5-15
rhododendron molle 2-4
distilled spirit 200-300


How do I change the code so that the output is formatted this way:

10-16 pts wt. red
13-17 pts wt. aconite
5-15 pts wt. suberect spatholobus stem
12-18 pts wt. tianxiong
2-4 pts wt. ligusticum striatum
10-18 pts wt. celastreae
25-35 pts wt. maca
18-22 pts wt. eucommia bark
10-20 pts wt. fennel
3-5 pts wt. radix paeoniae alba
10-18 pts wt. raw rheum officinale
10-20 pts wt. honeysuckle
10-20 pts wt. rhizoma arisaematis
4-8 pts wt. radix astragali
5-16 pts wt. talc
2-4 pts wt. asarum
16-20 pts wt. notopterygium root
8-25 pts wt. dried orange peel
2-6 pts wt. radix codonopsitis
10-20 pts wt. root of kudzu vine
17-23 pts wt. pangolin
8-25 pts wt. rehmannia glutinosa
11-15 pts wt. ground beeltle
5-15 pts wt. semen brassicae
2-4 pts wt. rhododendron molle
200-300 pts wt. distilled spirit



Sub Test()
Dim str As String
str = "red, 10-16 parts of aconite, 13-17 parts of suberect spatholobus stem, 5-15 parts of tianxiong, 12-18 parts ligusticum striatum, _
2-4 parts celastreae, 25-35 parts maca, 10-18 parts of eucommia bark, 18-22 parts of fennel, 10-20 parts of radix paeoniae alba, _
3-5 parts of raw rheum officinale, 10-18 parts of honeysuckle, 10-20 parts of rhizoma arisaematis, 10-20 parts of radix astragali, _
4-8 parts of talc, 5-16 parts of asarum, 2-4 parts of notopterygium root, 16-20 parts of dried orange peel, 8-25 parts of radix codonopsitis, _
2-6 parts of root of kudzu vine, 10-20 parts of pangolin, 17-23 parts of rehmannia glutinosa, 8-25 parts of ground beeltle, _
11-15 parts of semen brassicae, 5-15 parts of rhododendron molle 2-4 shares, distilled spirit 200-300 shares"
str = Replace(str, ",", "")
str = Replace(str, "parts of ", "pts wt.,")
str = Replace(str, "parts ", "pts wt.,")
str = Replace(str, "shares of ", "pts wt.,")
str = Replace(str, "shares ", "pts wt.,")
str = Replace(str, "shares", "pts wt.,")
Dim a As Variant
Dim b As Variant
a = Split(str, "pts wt.,")
b = UBound(a)
For i = 0 To b
Debug.Print a(i)
Next i
End Sub

[snb]

Sub M_snb()
sn = Split("raw rheum officinale 10-18")
c00 = Replace(Filter(sn, "-")(0), "-", " - ") & " pts. ws. " & Join(Filter(sn, "-", 0))
End sub

[mancubus]

was working on it with RegEx
:devil2:



Sub vbax_63844_rearrange_strings()
Dim toSplit As String
Dim arrSplit
Dim i As Long
toSplit = "red, 10-16 parts of aconite, 13-17 parts of suberect spatholobus stem, 5-15 parts of tianxiong, 12-18 parts ligusticum toSplitiatum, _
2-4 parts celatoSpliteae, 25-35 parts maca, 10-18 parts of eucommia bark, 18-22 parts of fennel, 10-20 parts of radix paeoniae alba, _
3-5 parts of raw rheum officinale, 10-18 parts of honeysuckle, 10-20 parts of rhizoma arisaematis, 10-20 parts of radix atoSplitagali, _
4-8 parts of talc, 5-16 parts of asarum, 2-4 parts of notopterygium root, 16-20 parts of dried orange peel, 8-25 parts of radix codonopsitis, _
2-6 parts of root of kudzu vine, 10-20 parts of pangolin, 17-23 parts of rehmannia glutinosa, 8-25 parts of ground beeltle, _
11-15 parts of semen brassicae, 5-15 parts of rhododendron molle 2-4 shares, distilled spirit 200-300 shares"
toSplit = Replace(Replace(Replace(Replace(Replace(Replace(toSplit, ",", ""), "parts of ", "pts wt.,"), "parts ", "pts wt.,"), "shares of ", _
"pts wt.,"), "shares ", "pts wt.,"), "shares", "pts wt.,")
'nest all 6 replaces in 1 line
arrSplit = Split(toSplit, "pts wt.,")
On Error Resume Next
For i = LBound(arrSplit) To UBound(arrSplit)
With CreateObject("VBScript.RegExp")
.Pattern = "[0-9]+-[0-9]+"
.Global = False 'one match only
.MultiLine = False
Debug.Print .Execute(arrSplit(i)).Item(0) & " pts. wt. " & .Replace(arrSplit(i), "")
End With
Next i
End Sub

[p45cal]

Nearly:
Sub Test()
myStr = "red, 10-16 parts of aconite, 13-17 parts of suberect spatholobus stem, 5-15 parts of tianxiong, 12-18 parts ligusticum striatum, 2-4 parts celastreae, 25-35 parts maca, 10-18 parts of eucommia bark, 18-22 parts of fennel, 10-20 parts of radix paeoniae alba, 3-5 parts of raw rheum officinale, 10-18 parts of honeysuckle, 10-20 parts of rhizoma arisaematis, 10-20 parts of radix astragali, 4-8 parts of talc, 5-16 parts of asarum, 2-4 parts of notopterygium root, 16-20 parts of dried orange peel, 8-25 parts of radix codonopsitis, 2-6 parts of root of kudzu vine, 10-20 parts of pangolin, 17-23 parts of rehmannia glutinosa, 8-25 parts of ground beeltle, 11-15 parts of semen brassicae, 5-15 parts of rhododendron molle 2-4 shares, distilled spirit 200-300 shares"

myStr = Replace(myStr, "parts of ", "¬")
myStr = Replace(myStr, "parts ", "¬")
myStr = Replace(myStr, "parts", "¬")
myStr = Replace(myStr, "shares of ", "¬")
myStr = Replace(myStr, "shares ", "¬")
myStr = Replace(myStr, "shares", "¬")
a = Split(myStr, "¬")

b = UBound(a)
On Error Resume Next
For i = 0 To b
Z = Split(a(i), ",")
Debug.Print Application.Trim(Join(Array(Z(1), "pts wt.", Z(0))))
Next i
End Sub


To a naive eye, I would have thought more like:
Sub test2()
myStr = "red, 10-16 parts of aconite, 13-17 parts of suberect spatholobus stem, 5-15 parts of tianxiong, 12-18 parts ligusticum striatum, 2-4 parts celastreae, 25-35 parts maca, 10-18 parts of eucommia bark, 18-22 parts of fennel, 10-20 parts of radix paeoniae alba, 3-5 parts of raw rheum officinale, 10-18 parts of honeysuckle, 10-20 parts of rhizoma arisaematis, 10-20 parts of radix astragali, 4-8 parts of talc, 5-16 parts of asarum, 2-4 parts of notopterygium root, 16-20 parts of dried orange peel, 8-25 parts of radix codonopsitis, 2-6 parts of root of kudzu vine, 10-20 parts of pangolin, 17-23 parts of rehmannia glutinosa, 8-25 parts of ground beeltle, 11-15 parts of semen brassicae, 5-15 parts of rhododendron molle 2-4 shares, distilled spirit 200-300 shares"
myStr = Replace(myStr, "parts of ", "¬")
myStr = Replace(myStr, "parts ", "¬")
myStr = Replace(myStr, "parts", "¬")
myStr = Replace(myStr, "shares of ", "¬")
myStr = Replace(myStr, "shares ", "¬")
myStr = Replace(myStr, "shares", "¬")
a = Split(myStr, ",")
For i = LBound(a) To UBound(a)
Debug.Print Application.Trim(Replace(a(i), "¬", " pts wt. "))
Next i
End Sub

[swaggerbox]

wow thanks a lot guys

[swaggerbox]

Quick question guys: How do I change the code so that output would not be from debug.print but to activesheet.textbox7.text

[p45cal]

Change

Debug.print
To

activesheet.textbox7.text =

[swaggerbox]

I did that but only the last line is copied.

[p45cal]

What do you want in the text box? One long string? A vertical list... that you can choose from? Is it a text box you want, or something else?

[snb]

Did you overlook #2 ?

[swaggerbox]

I need the output in one long list separated by comma.

[p45cal]

Sub Test()
myStr = "red, 10-16 parts of aconite, 13-17 parts of suberect spatholobus stem, 5-15 parts of tianxiong, 12-18 parts ligusticum striatum, 2-4 parts celastreae, 25-35 parts maca, 10-18 parts of eucommia bark, 18-22 parts of fennel, 10-20 parts of radix paeoniae alba, 3-5 parts of raw rheum officinale, 10-18 parts of honeysuckle, 10-20 parts of rhizoma arisaematis, 10-20 parts of radix astragali, 4-8 parts of talc, 5-16 parts of asarum, 2-4 parts of notopterygium root, 16-20 parts of dried orange peel, 8-25 parts of radix codonopsitis, 2-6 parts of root of kudzu vine, 10-20 parts of pangolin, 17-23 parts of rehmannia glutinosa, 8-25 parts of ground beeltle, 11-15 parts of semen brassicae, 5-15 parts of rhododendron molle 2-4 shares, distilled spirit 200-300 shares"

myStr = Replace(myStr, "parts of ", "¬")
myStr = Replace(myStr, "parts ", "¬")
myStr = Replace(myStr, "parts", "¬")
myStr = Replace(myStr, "shares of ", "¬")
myStr = Replace(myStr, "shares ", "¬")
myStr = Replace(myStr, "shares", "¬")
a = Split(myStr, "¬")

b = UBound(a)
On Error Resume Next
For i = 0 To b
Z = Split(a(i), ",")
'Debug.Print Application.Trim(Join(Array(Z(1), "pts wt.", Z(0))))
ThisStr = Application.Trim(Join(Array(Z(1), "pts wt.", Z(0))))
If YourStr = "" Then YourStr = ThisStr Else YourStr = Join(Array(YourStr, ThisStr, ","))
Next i
ActiveSheet.textbox7.Text = YourStr
End Sub
You can do similar with others' suggestions.

[snb]

Sub M_snb()
sn = Split(Replace("red, 10-16 parts of aconite, 13-17 parts of suberect spatholobus stem, 5-15 parts of tianxiong, 12-18 parts ligusticum striatum, 2-4 parts celastreae, 25-35 parts maca, 10-18 parts of eucommia bark, 18-22 parts of fennel, 10-20 parts of radix paeoniae alba, 3-5 parts of raw rheum officinale, 10-18 parts of honeysuckle, 10-20 parts of rhizoma arisaematis, 10-20 parts of radix astragali, 4-8 parts of talc, 5-16 parts of asarum, 2-4 parts of notopterygium root, 16-20 parts of dried orange peel, 8-25 parts of radix codonopsitis, 2-6 parts of root of kudzu vine, 10-20 parts of pangolin, 17-23 parts of rehmannia glutinosa, 8-25 parts of ground beeltle, 11-15 parts of semen brassicae, 5-15 parts of rhododendron molle 2-4 shares, distilled spirit 200-300 shares", " of ", " "), ", ")

For j = 0 To UBound(sn) - 1
sn(j) = Split(sn(j + 1))(0) & " pts wt. " & Join(Filter(Filter(Split(sn(j)), "-", 0), "part", 0))
Next
MsgBox Join(sn, ",")
End Sub

[swaggerbox]

P45cal and snb: You just made my day. Thanks a lot guys!