Split Text Across Multiple Columns and Add Additional Text

[Jim Clayton]

Hello again. I'm fine tuning my line of questioning over the last few posts I've made...think I have it narrowed down to what I'm trying to do. I'm looking to take a string of text, split it across multiple columns, and insert additional text at certain points. Example of string:
FLG 1-1/2" 300 316 RF BLD
The separation would go as follows with the added text in parentheses:
FLG 1-1/2" 300(#) 316(SS) RF BLD
The idea would be to do this via macro. Anyone know of a way to go about this? It would be greatly appreciated. Apologies for the lack of workbook...I only have a phone at the moment.

[kersplash]

Attach a sample workbook (with more than one sample), showing your expected output for that sample.

Go Advanced -> Manage Attachments -> Upload

[chandrau03]

Hi

I want a userform to filter following items from the list. please help me. this is my first thread so please help.
all the comboboxes (Dynamic) should be related to each other. and results as filtered data should reflect in listbox.

Fields
KFI Operator
Verify Operator
KFI Error
Verify Error

and the table is as below:

I have 16 columns:

Fields is in column 5
KFI Opt is in 9
Verify Opt is in 10
KFI Error is in 13
Verify Error is in 14.


Thanks,
Umesh

[Jim Clayton]

Will do...as soon as I have pc access.

[ikboy]

Sub zz()
Dim s$, x(1), n%, k, t
s = "FLG 1-1/2" & """" & " 300 316 RF BLD"
x(0) = "(#) ": x(1) = "(SS)"
With CreateObject("vbscript.regexp")
    .Pattern = "(\d{3,} \d{3,})"
    If .test(s) Then
        k = .Execute(s)(0)
        t = Split(k, " ")
        s = Replace(s, k, t(0) & x(0) & t(1) & x(1))
    End If
End With
msgbox s
End Sub

[jolivanes]

Or a slower version maybe
As per your example.

Sub Jim_Clayton()
Dim a, i As Long
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        a = Split(Cells(i, 1), " ")
            Cells(i, 1).Offset(, 1) = a(0) & " " & a(1) & " " & a(2) & "(#)" & " " & a(3) & "(SS)" & " " & a(4) & " " & a(5)
    Next i
End Sub

[Jim Clayton]

Have a computer now...let me try this again. Workbook attached. I'm looking to take a string of text, split it across multiple columns, and insert additional text at certain points. Example of string:
FLG 1-1/2" 300 316 RF BLD
The separation would go as follows with the text that needs to be added in parentheses:
FLG 1-1/2" 300(#) 316(SS) RF BLD
The idea would be to do this via macro. I tried the ones above but they don't seem to be quite what I'm after, however the effort is much appreciated. The attached workbook is laid out as follows: Column D= A combination of columns R & S. This would be the column that needs splitting up. If you scroll over to Column T you will see that I did the "Text to Columns" function to do exactly that. This is probably the closest I've gotten to what I'm trying to achieve. Where it's still falling short is that these are abbreviated descriptions and I need to "un-abbreviate" them and place the information in columns G:O. So something like RFWN would need to become Raised Face Weld Neck. Which can be done through substitution, but there's a lot of information and a lot of steps. The other thing is numbers like 600, 900, 1500 all need a # sign after them. And numbers like 316 or 347 need SS after them. So there are a lot of different things that need to be done and I'm trying to figure out the best way to do it. The Substitute function works great, the Text to Column feature works great. I'm just looking for a way to combine the steps, and fill in the blanks. Confused Yet? Thanks to anyone willing to help.

[Jim Clayton]

Clarifying request after alot of searching/ trial and error: A macro that can split a text string into multiple columns, substitute portions of text, add suffix to portions of text. Anyone have that lying around in their back pocket somewhere? You'd be my hero.

[jindon]

Can you just upload a sample workbook with a small amount of data and the result that you want clearly showing the logic behind it?
Of course the data should be consist of variety of possible different patterns.

I'll be busy today, so reply will be late.

[jolivanes]

Re: A macro that can split a text string into multiple columns.
Following would do that.

Sub AAAAC()
Dim c As Range, a
    For Each c In Range("R2:R" & Cells(Rows.Count, "R").End(xlUp).Row)
        a = Split(Replace(c, ",", ""), " ")
            c.Offset(, 2).Resize(, UBound(a) + 1) = a
    Next c
End Sub

How do you apply the logic from your example (FLG 1-1/2" 300 316 RF BLD -----> FLG 1-1/2" 300# 316SS RF BLD) to, for instance, these?
BLD-FLG B16.5 1 1/2" 300 RF
1, 600, RFWN, F316/L SCHXXS
1/2, 600, RFWN, 347 SCH160

I am convinced that someone, certainly jindon, will come up with a solution but in the meantime we can play with it to see what we can arrange.

[Jim Clayton]

Okay. I managed to get a workbook updated. scroll down to row 100 and you'll find a short description that hopefully answers a lot of questions, as well as some code that might prove useful. Please let me know if anything further is needed. Thanks to everyone for their help. Also, attached workbook might be in 2007 and the original was in 2010. My computer situation at the moment needs improvement to say the least. Thanks again.

[jolivanes]

Column D split into Column G and on

Sub AAAAA()
Dim c As Range, a
    For Each c In Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row)
        a = Split(Replace(c, ",", ""), " ")
            c.Offset(, 3).Resize(, UBound(a) + 1) = a
    Next c
End Sub

How would you determine if a value of for instance 550 would get SS or # as suffix?

[Jim Clayton]

Going to answer this as best I can. The # sign. It applies to the flange Class/Rating. If memory serves me those numbers should be 150,300,600,900,1500,2500 and nothing else. The SS suffix applies to certain Materials. Those numbers should be 316,310,304,317 & 321. Where it gets confusing is there is 316/L,304H,F316/L, etc...the SS does not apply to those. Hopefully that helps clarify the suffix portion a little. Let me know if anything further is needed. Thanks for the help.

[Jim Clayton]

One of the issues that I'm running into that is noticable when the text is transferred to columns is that it's all inconsistent. One column may have data for Flange type, Material, Class/Rating, & Schedule. That's because each row of data was entered differently originally. But the goal is to separate them,ie; Material in one column, Flame Type in one column, Size on one column,etc.

[6StringJazzer]

chandrau03, your question is not related to this thread.

Unfortunately your post does not comply with Rule 2 of our Forum RULES. Do not post a question in the thread of another member -- start your own thread.

If you feel an existing thread is particularly relevant to your need, provide a link to the other thread in your new thread.

[jindon]

Jim Clayton,

Thanks for the workbook, but I need to see some of ACTUAL data in col.G:O, so that we can test result of the code with the actual result that you need.

[Jim Clayton]

Revised workbook per request. Columns E and G:O are the ones in question. I've updated the information as accurately as possible. Hopefully this gives you a better idea of what I'm talking about and also the challenges ahead. Thanks again for all the help.

[jindon]

I just got the logic for Col.G to J.

I don't understand the logic for the rest.

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 9)
    End With
    With CreateObject("VBScript.RegExp")
        For i = 1 To UBound(a, 1)
            .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, 1) = sm(0) & """"
                Else
                    b(i, 1) = sm(1) & IIf(sm(1) <> "", "-", "") & sm(2) & """"
                End If
            End If
            .Pattern = "\bRF(WN)?\b"
            If .test(a(i, 1)) Then
                If .Execute(a(i, 1))(0).submatches(0) = "" Then
                    b(i, 2) = "RF Blind"
                Else
                    b(i, 2) = "Raised Face Weld Neck"
                End If
            End If
            .Pattern = "\b\d+0{2}\b"
            If .test(a(i, 1)) Then b(i, 3) = .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, 4) = StrConv(sm(0), 3) & IIf(sm(1) <> "", ".", "") & sm(1)
            End If
        Next
        Sheets("sheet1").Range("g2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
    End With
End Sub

[Jim Clayton]

You and me both... seriously I appreciate all the help. I wasn't anticipating a solution that got me 100% of the way there. If the above can knock out some of the steps and I can combine it with something else and spend 10 minutes on it when I'm updating it rather than the excessive amount of time I was spending before, that works for me. The problem is that alot of the data is hard to justify. It makes sense to me because I look at it every day. But, I digress. Thanks for all the help and time spent on this.

[jindon]

You are welcome.

If you upload a workbook with the data with the lines that the code doesn't pic up the correct data in each column, it may be solved 100%.
So, presenting all the possible different pattern of data and the correct data in each column is very important, and they should not be more than 50 records.

[Jim Clayton]

Alright, I've got two workbooks for you. The first one is to hopefully help clarify a lot of the questions and inconsistencies and the second is as you requested...pretty sure that's what you were asking for. For the most part the code looks like it's working really well with only minor gaps here and there. It's light years beyond anything I'm capable of. Very much appreciated. Thanks.

[jindon]

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

[Jim Clayton]

The Item Number is auto generated from a report into a separate column and is not part of the description. The Description is what I'm trying to split. Why it's confusing is that there is Material, Item Number, Size, and the middle one has nothing to do with the other two. Unfortunately it has to be structured this way for steps that will take place further along in the process. It's essentially just jumping a column. Hopefully that helps. Thanks again.

[jindon]

If that takes care of your original question, select Thread Tools from the menu link above and mark this thread as SOLVED.

[Jim Clayton]

Thanks again. Appreciate the help.