Andrew Perry
Andrew Perry

Reputation: 765

Code to combine common parts of text strings

If I have a list of strings in a spreadsheet, is there any way to combine them to keep only the strings they have in common? For instance, if I have this list:

C- D2 Carbon steel column  1   7.58   0.47    1.15    1,096.00
C-E1 Carbon steel column   1   7.58   0.47    1.15    1,096.00
C- E2 Carbon steel column  1   7.58   0.47    1.15    1,096.00
C-F1 Carbon steel column   1   7.58   0.47    1.15    1,096.00
C-F2 Carbon steel column   1   7.58   0.47    1.15    1,096.00
C-G1 Carbon steel column   1   7.58   0.47    1.15    1,096.00
C-G2 Carbon steel column   1   7.58   0.47    1.15    1,096.00
C-H1 Carbon steel column   1   7.58   0.47    1.15    1,096.00

...and I want to combine it into

Carbon steel column        8   7.58   0.47    1.15    1,096.00

Doing the numbers aren't a problem, but how do I grab the common elements of the text strings?

EDIT: To clarify, the aim is to find the common elements, not just separate them out. It's unfortunately not a thing where the end phrase is known beforehand.

Upvotes: 1

Views: 90

Answers (2)

CMArg
CMArg

Reputation: 1567

You can try to split the first cell in its components (assuming is the space), and add all words in a collection. Then, for each other cell, split it and check if the collection already has the words. If not, delet it from the collection.

Dim MyCollection As Collection
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim bIsInArray As Boolean
Dim sFinalString As String


Private Sub CommandButton1_Click()
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'get the number of rows with data
Set MyCollection = New Collection
ReDim MyArray(1 To 1) As String
For i = 2 To lLastRow 'Assuming your data starts in A2 (A1 being titles)
    If i = 2 Then 'The first data cell
        MyArray = Split(Worksheets("Data").Cells(i, 1).Value, " ") 'split the cell using spaces as spliting character
        For j = 0 To UBound(MyArray)
            MyCollection.Add (MyArray(j)) 'add all words to collection
        Next
    Else 'if is not the first cell of data
        ReDim MyArray(1 To 1) As String 'set a "new" array
        MyArray = Split(Worksheets("Data").Cells(i, 1).Value, " ")

        For j = MyCollection.Count To 1 Step -1
            bIsInArray = False
            For k = 0 To UBound(MyArray)
                If MyCollection.Item(j) = MyArray(k) Then
                    bIsInArray = True
                End If
            Next
            If bIsInArray = False Then
                MyCollection.Remove (j)
            End If
        Next

    End If
Next
'Now MyCollection contains all common words

sFinalString = ""
For j = 1 To MyCollection.Count
    sFinalString = sFinalString & " " & MyCollection.Item(j)
Next
Worksheets("Data").Cells(lLastRow + 2, 1).Value = sFinalString
End Sub

Upvotes: 0

user4039065
user4039065

Reputation:

In B11:B12 as one of these SUMIF functions,

=SUMIF($A$2:$A$9, "*Carbon steel column", B$2:B$9)     '◄ B11
=SUMIF($A$2:$A$9, "*"&$A12, B$2:B$9)                   '◄ B12

Note the prefacing wildcard asterisk. This means that column A will end in Carbon steel column. Fill right for additional column totals. Substitute with the AVERAGEIF function or some other aggregating function to achieve the desired results.

      carbno_steel_column

Upvotes: 1

Related Questions