Split Text String based on listing

Lenard

New Member
Joined
Jan 19, 2010
Messages
35
Office Version
  1. 2019
Platform
  1. Windows
Hi,

I have a set of data in column A with text string in each row under Data sheet and would like to split text string in each row based on a listing of keywords ( Unique name ) under List sheet.
I copied set of formulas from google search and modified, the result is not met my expectation.

{=IFERROR(INDEX(List!$A$2:$A$71, SMALL(IF(COUNTIF($A2, "*"&List!$A$2:$A$71&"*"), MATCH(ROW(List!$A$2:$A$71), ROW(List!$A$2:$A$71)), ""), COLUMNS($M$1:M1))), "")}

Sample file_working.xlsx
A
1Keyword
2ABS
3ADDRESS
4AGGREGATE
5AND
6AVERAGE
7CELL
8COLUMN
9CONCAT
10COUNT
11COUNTA
12COUNTBLANK
13COUNTIF
14COUNTIFS
15DATE
16EDATE
17EOMONTH
18EXACT
19FILTER
20FIND
21FLOOR
22FREQUENCY
23HYPERLINK
24IF
25INDEX
26INDIRECT
27ISBLANK
28ISERR
29ISERROR
30ISNA
31ISNUMBER
32LARGE
33LEFT
34LEN
35LET
36LOWER
37MATCH
38MAX
39MID
40MIN
41MMULT
42MOD
43NOT
44ODD
45OFFSET
46OR
47POWER
48PROPER
49RANK
50REPT
51RIGHT
52ROW
53SEARCH
54SEQUENCE
55SMALL
56SORT
57SUBTOTAL
58SUM
59SUMIF
60SUMPRODUCT
61TEXT
62TODAY
63TRANSPOSE
64UNIQUE
65UPPER
66LOOKUP
67XLOOKUP
68HLOOKUP
69VLOOKUP
70WEEKDAY
71YEAR
List


Sample file_working.xlsx
ABCDEFGHIJ
1DataResults
2COUNTIFSFINDLEFTRIGHTCOUNTCOUNTIFCOUNTIFSFINDIFLEFTRIGHT
3COUNTIFSDATECOUNTCOUNTIFCOUNTIFSDATEIF  
4COUNTIFSCOUNTIFCOUNTCOUNTIFCOUNTIFSIF   
5COUNTIFCOUNTCOUNTIFIF    
6SUMPRODUCTEXACTEXACTSUMSUMPRODUCT    
7COUNTIFSUMPRODUCTISNUMBERMATCHCOUNTCOUNTIFCOUNTIFSIFISNUMBERMATCHSUMSUMPRODUCT
8COUNTIFSUMPRODUCTCOUNTCOUNTIFCOUNTIFSIFSUMSUMPRODUCT  
9MATCHISNASUMPRODUCTCOUNTACOUNTIFCOUNTCOUNTACOUNTIFIFISNAMATCHSUMSUMPRODUCT
10COUNTIFSSUMPRODUCTCOUNTCOUNTIFCOUNTIFSIFSUMSUMPRODUCT  
11SUMPRODUCTLENNLENSUMSUMPRODUCT     
12COUNTBLANKCOUNTACOUNTCOUNTACOUNTBLANK     
13COUNTACOUNTIFCOUNTIFSCOUNTCOUNTACOUNTIFCOUNTIFSIF   
14COUNTIFCOUNTIFSCOUNTCOUNTIFCOUNTIFSIF   
15SUMPRODUCTISNUMBERFINDFINDISNUMBERSUMSUMPRODUCT   
16COUNTIFSUMPRODUCTISNUMBERFINDCOUNTCOUNTIFCOUNTIFSFINDIFISNUMBERSUM
17SUMPRODUCTISERRORISERRSUMISERRISERRORORSUMSUMPRODUCT  
18COUNTSUMPRODUCTCOUNTSUMSUMPRODUCT    
19SUMPRODUCTMODMODSUMSUMPRODUCT    
20COUNTIFSUMPRODUCTFINDISNUMBERCOUNTCOUNTIFCOUNTIFSFINDIFISNUMBERSUMSUMPRODUCT
21COUNTIFISTEXTSUMPRODUCTCOUNTIFSCOUNTCOUNTIFCOUNTIFSIFSUMSUMPRODUCTTEXT
22ISERRORNOTSUMPRODUCTISERRISERRISERRORNOTORSUMSUMPRODUCT 
23ISNUMBERSEARCHMMULTTRANSPOSEISNUMBERMMULTSEARCHTRANSPOSE   
24SUMPRODUCTWEEKDAYSUMSUMPRODUCTWEEKDAY    
25YEARSUMPRODUCTSUMSUMPRODUCTYEAR    
26SUMPRODUCTSUMSUMPRODUCT     
27COUNTIFSCOUNTCOUNTIFCOUNTIFSIF   
28SUMPRODUCTCOUNTIFCOUNTCOUNTIFIFSUMSUMPRODUCT  
29SUMPRODUCTISNUMBERMATCHSEARCHISNUMBERMATCHSEARCHSUMSUMPRODUCT  
30SUMPRODUCTISNAMATCHISNAMATCHSUMSUMPRODUCT   
Data
Cell Formulas
RangeFormula
C21:I30,C20:J20,C14:I19,C7:J13,C2:I6C2=IFERROR(INDEX(List!$A$2:$A$71, SMALL(IF(COUNTIF($A2, "*"&List!$A$2:$A$71&"*"), MATCH(ROW(List!$A$2:$A$71), ROW(List!$A$2:$A$71)), ""), COLUMNS($M$1:M1))), "")
Press CTRL+SHIFT+ENTER to enter array formulas.



The expected result is to separate text string in each row by columnar result or the result can be concatenated with "+" as per sample below : -

1628573847220.png


Or Expected Results :-
1628573920300.png



Appreciate if someone can help to use better set of formulas or vba to solve the above problem
Thanks in advance

Regards
Lenard
 

aRandomHelper

Active Member
Joined
Jan 14, 2021
Messages
301
Office Version
  1. 2016
Platform
  1. Windows
Well, then I am baffled. I have the same references used, including the Microsoft Forms 2.0. And of course the previously mentioned Common Controls one, but the code still worked for me when I removed the Common Controls one. Theoretically the code should work but I have no idea why it doesn't. Maybe you can try the solution by Peter.
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).

Lenard

New Member
Joined
Jan 19, 2010
Messages
35
Office Version
  1. 2019
Platform
  1. Windows
You could try this procedure.

VBA Code:
Sub SearchWords()
  Dim a As Variant, b As Variant, c As Variant, itm As Variant
  Dim i As Long, pos As Long
  Dim s As String
 
  With Sheets("List")
    With .Range("A2", .Range("A" & Rows.Count).End(xlUp))
      a = .Value
      .Value = Evaluate(Replace("text(len(#),""00"")&#", "#", .Address(External:=True)))
      .Sort Key1:=.Cells(1), Order1:=xlDescending, Header:=xlNo
      .TextToColumns DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(2, 1))
      b = .Value
      .Value = a
    End With
  End With
  With Sheets("Data")
    a = .Range("A2", Range("A" & Rows.Count).End(xlUp))
    ReDim c(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      s = vbNullString
      For Each itm In b
        pos = InStr(1, a(i, 1), itm)
        If pos > 0 Then
          s = s & "+" & Mid(a(i, 1), pos, Len(itm))
          Mid(a(i, 1), pos, Len(itm)) = String(Len(itm), ".")
          If Len(Replace(a(i, 1), ".", "")) = 0 Then Exit For
        End If
      Next itm
      c(i, 1) = Mid(s, 2)
    Next i
    .Range("B2").Resize(UBound(c)).Value = c
  End With
End Sub

My test data and results:

'List' sheet is the same as yours from post #1

Lenard.xlsm
AB
1DataResults
2COUNTIFSFINDLEFTRIGHTCOUNTIFS+RIGHT+LEFT+FIND
3COUNTIFSDATECOUNTIFS+DATE
4COUNTIFSCOUNTIFCOUNTIFS+COUNTIF
5COUNTIFCOUNTIF
6SUMPRODUCTEXACTSUMPRODUCT+EXACT
7COUNTIFSUMPRODUCTISNUMBERMATCHSUMPRODUCT+ISNUMBER+COUNTIF+MATCH
8COUNTIFSUMPRODUCTSUMPRODUCT+COUNTIF
9MATCHISNASUMPRODUCTCOUNTACOUNTIFSUMPRODUCT+COUNTIF+COUNTA+MATCH+ISNA
Data

Hi Peter,

Thanks so much that after testing vba code, the expected results are perfectly matched.
I need to digest vba codes and so much to learn on new things.

Cheers
Lenard
 
Last edited by a moderator:

Lenard

New Member
Joined
Jan 19, 2010
Messages
35
Office Version
  1. 2019
Platform
  1. Windows
Well, then I am baffled. I have the same references used, including the Microsoft Forms 2.0. And of course the previously mentioned Common Controls one, but the code still worked for me when I removed the Common Controls one. Theoretically the code should work but I have no idea why it doesn't. Maybe you can try the solution by Peter.
Hi,

Thanks for your time and believe that your codes will work well by adding common controls reference in vba and now tried Peter's codes, it works great

Cheers
Lenard
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
51,780
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

now tried Peter's codes, it works great
Actually, there is a slight error in my code - a "." is missing. If you run the code when the 'List' sheet (or any sheet other than 'Data') is the active sheet, the code will error.
Corrected version is below.

VBA Code:
Sub SearchWords()
  Dim a As Variant, b As Variant, c As Variant, itm As Variant
  Dim i As Long, pos As Long
  Dim s As String
  
  With Sheets("List")
    With .Range("A2", .Range("A" & Rows.Count).End(xlUp))
      a = .Value
      .Value = Evaluate(Replace("text(len(#),""00"")&#", "#", .Address(External:=True)))
      .Sort Key1:=.Cells(1), Order1:=xlDescending, Header:=xlNo
      .TextToColumns DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(2, 1))
      b = .Value
      .Value = a
    End With
  End With
  With Sheets("Data")
    a = .Range("A2", .Range("A" & Rows.Count).End(xlUp)) '<- There was "." missing in this line
    ReDim c(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      s = vbNullString
      For Each itm In b
        pos = InStr(1, a(i, 1), itm)
        If pos > 0 Then
          s = s & "+" & Mid(a(i, 1), pos, Len(itm))
          Mid(a(i, 1), pos, Len(itm)) = String(Len(itm), ".")
          If Len(Replace(a(i, 1), ".", "")) = 0 Then Exit For
        End If
      Next itm
      c(i, 1) = Mid(s, 2)
    Next i
    .Range("B2").Resize(UBound(c)).Value = c
  End With
End Sub
 
Solution

Lenard

New Member
Joined
Jan 19, 2010
Messages
35
Office Version
  1. 2019
Platform
  1. Windows
Actually, there is a slight error in my code - a "." is missing. If you run the code when the 'List' sheet (or any sheet other than 'Data') is the active sheet, the code will error.

a = .Range("A2", .Range("A" & Rows.Count).End(xlUp)) '<- There was "." missing in this line
Noted, thanks Peter

Regards
Lenard
 

Lenard

New Member
Joined
Jan 19, 2010
Messages
35
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Hi Peter,
Hi Peter,

Not sure about this :-

"Evaluate(Replace("text(len(#),""00"")&#", "#", .Address(External:=True)))
.Sort Key1:=.Cells(1), Order1:=xlDescending, Header:=xlNo
.TextToColumns DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(2, 1))
"

Perhaps can further elaborate, thanks

Regards
Lenard

Noted, thanks Peter

Regards
Lenard
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
51,780
Office Version
  1. 365
Platform
  1. Windows
Not sure about this :-

"Evaluate(Replace("text(len(#),""00"")&#", "#", .Address(External:=True)))
.Sort Key1:=.Cells(1), Order1:=xlDescending, Header:=xlNo
.TextToColumns DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(2, 1))
"

Perhaps can further elaborate, thanks

Evaluate(Replace("text(len(#),""00"")&#", "#", .Address(External:=True))
Replace everything in the 'List' sheet with its length followed by its text. So 'REPT' becomes '04REPT' and 'SUMPRODUCT' becomes '10SUMPRODUCT' etc

.Sort Key1:=.Cells(1), Order1:=xlDescending, Header:=xlNo
Now sort all those values in descending order. That gets all the longer ones to the top and the short ones to the bottom.

.TextToColumns DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(2, 1))"
Do Text to Columns but ignore the first column of 2 characters. This just leaves the original function names (but with the longest ones at the top and shortest ones at the bottom)
 

Lenard

New Member
Joined
Jan 19, 2010
Messages
35
Office Version
  1. 2019
Platform
  1. Windows
Evaluate(Replace("text(len(#),""00"")&#", "#", .Address(External:=True))
Replace everything in the 'List' sheet with its length followed by its text. So 'REPT' becomes '04REPT' and 'SUMPRODUCT' becomes '10SUMPRODUCT' etc

.Sort Key1:=.Cells(1), Order1:=xlDescending, Header:=xlNo
Now sort all those values in descending order. That gets all the longer ones to the top and the short ones to the bottom.

.TextToColumns DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(2, 1))"
Do Text to Columns but ignore the first column of 2 characters. This just leaves the original function names (but with the longest ones at the top and shortest ones at the bottom)
Thanks Peter.
 

Forum statistics

Threads
1,148,007
Messages
5,744,319
Members
423,861
Latest member
Ka3EeM

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top