Split Text Across Multiple Columns and Add Additional Text

I just don't know where "Item Number" come from.

Sub test()
    Dim a, b, i As Long, m As Object, sm As Object
    With Sheets("sheet1")
        a = .Range("d2", .Range("d" & Rows.Count).End(xlUp)).Value
        ReDim b(1 To UBound(a, 1), 1 To 11)
    End With
    With CreateObject("VBScript.RegExp")
        For i = 1 To UBound(a, 1)
            .Pattern = "\bUNS\-(S)(\d+)\d{2}(/S(\d+)\d{2})?\b"
            If .test(a(i, 1)) Then
                Set sm = .Execute(a(i, 1))(0).submatches
                If sm(2) = "" Then
                    b(i, 1) = sm(1) & String(2, sm(0))
                Else
                    b(i, 1) = "F" & sm(1) & "/F" & sm(3) & "L"
                End If
                a(i, 1) = .Replace(a(i, 1), "")
            End If
            .Pattern = "^(\d+)(?=,)|(\d*) *(\d+/\d+(?="")?)"
            If .test(a(i, 1)) Then
                Set sm = .Execute(a(i, 1))(0).submatches
                If sm(0) <> "" Then
                    b(i, 3) = sm(0) & """"
                Else
                    b(i, 3) = sm(1) & IIf(sm(1) <> "", "-", "") & sm(2) & """"
                End If
                a(i, 1) = .Replace(a(i, 1), "")
            End If
            .Pattern = "\b(R(F|J))(WN)?( BLD)?\b"
            If .test(a(i, 1)) Then
                If .Execute(a(i, 1))(0).submatches(3) <> "" Then
                    b(i, 4) = "RT J Blind"
                Else
                    b(i, 4) = "Raised Face Weld Neck"
                End If
                a(i, 1) = .Replace(a(i, 1), "")
            End If
            .Pattern = "\b\d+0{2}\b"
            If .test(a(i, 1)) Then b(i, 5) = .Execute(a(i, 1))(0) & "#"
            .Pattern = "\b(SCH)(\S+)?\b"
            If .test(a(i, 1)) Then
                Set sm = .Execute(a(i, 1))(0).submatches
                b(i, 6) = StrConv(sm(0), 3) & IIf(sm(1) <> "", ".", "") & sm(1)
                a(i, 1) = .Replace(a(i, 1), "")
            End If
            .Pattern = "\b[A-Z]+, [A-Z]+\b"
            If .test(a(i, 1)) Then
                b(i, 10) = .Execute(a(i, 1))(0)
                a(i, 1) = .Replace(a(i, 1), "")
            End If
            .Pattern = " [A-Z ]+$"
            If .test(a(i, 1)) Then b(i, 11) = Trim(StrConv(.Execute(a(i, 1))(0), 3))
        Next
        Sheets("sheet1").Range("e2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
    End With
End Sub