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