Split Text String based on listing

[Lenard]

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

Sample file_working.xlsx
	A	B	C	D	E	F	G	H	I	J
1	Data		Results
2	COUNTIFSFINDLEFTRIGHT		COUNT	COUNTIF	COUNTIFS	FIND	IF	LEFT	RIGHT
3	COUNTIFSDATE		COUNT	COUNTIF	COUNTIFS	DATE	IF
4	COUNTIFSCOUNTIF		COUNT	COUNTIF	COUNTIFS	IF
5	COUNTIF		COUNT	COUNTIF	IF
6	SUMPRODUCTEXACT		EXACT	SUM	SUMPRODUCT
7	COUNTIFSUMPRODUCTISNUMBERMATCH		COUNT	COUNTIF	COUNTIFS	IF	ISNUMBER	MATCH	SUM	SUMPRODUCT
8	COUNTIFSUMPRODUCT		COUNT	COUNTIF	COUNTIFS	IF	SUM	SUMPRODUCT
9	MATCHISNASUMPRODUCTCOUNTACOUNTIF		COUNT	COUNTA	COUNTIF	IF	ISNA	MATCH	SUM	SUMPRODUCT
10	COUNTIFSSUMPRODUCT		COUNT	COUNTIF	COUNTIFS	IF	SUM	SUMPRODUCT
11	SUMPRODUCTLENN		LEN	SUM	SUMPRODUCT
12	COUNTBLANKCOUNTA		COUNT	COUNTA	COUNTBLANK
13	COUNTACOUNTIFCOUNTIFS		COUNT	COUNTA	COUNTIF	COUNTIFS	IF
14	COUNTIFCOUNTIFS		COUNT	COUNTIF	COUNTIFS	IF
15	SUMPRODUCTISNUMBERFIND		FIND	ISNUMBER	SUM	SUMPRODUCT
16	COUNTIFSUMPRODUCTISNUMBERFIND		COUNT	COUNTIF	COUNTIFS	FIND	IF	ISNUMBER	SUM
17	SUMPRODUCTISERRORISERRSUM		ISERR	ISERROR	OR	SUM	SUMPRODUCT
18	COUNTSUMPRODUCT		COUNT	SUM	SUMPRODUCT
19	SUMPRODUCTMOD		MOD	SUM	SUMPRODUCT
20	COUNTIFSUMPRODUCTFINDISNUMBER		COUNT	COUNTIF	COUNTIFS	FIND	IF	ISNUMBER	SUM	SUMPRODUCT
21	COUNTIFISTEXTSUMPRODUCTCOUNTIFS		COUNT	COUNTIF	COUNTIFS	IF	SUM	SUMPRODUCT	TEXT
22	ISERRORNOTSUMPRODUCTISERR		ISERR	ISERROR	NOT	OR	SUM	SUMPRODUCT
23	ISNUMBERSEARCHMMULTTRANSPOSE		ISNUMBER	MMULT	SEARCH	TRANSPOSE
24	SUMPRODUCTWEEKDAY		SUM	SUMPRODUCT	WEEKDAY
25	YEARSUMPRODUCT		SUM	SUMPRODUCT	YEAR
26	SUMPRODUCT		SUM	SUMPRODUCT
27	COUNTIFS		COUNT	COUNTIF	COUNTIFS	IF
28	SUMPRODUCTCOUNTIF		COUNT	COUNTIF	IF	SUM	SUMPRODUCT
29	SUMPRODUCTISNUMBERMATCHSEARCH		ISNUMBER	MATCH	SEARCH	SUM	SUMPRODUCT
30	SUMPRODUCTISNAMATCH		ISNA	MATCH	SUM	SUMPRODUCT
Data

Cell Formulas
Range	Formula
C21:I30,C20:J20,C14:I19,C7:J13,C2:I6	C2	=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 : -

Or Expected Results :-

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

Regards
Lenard

 

[aRandomHelper]

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.

 

[Lenard]

You could try this procedure.

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
	A	B
1	Data	Results
2	COUNTIFSFINDLEFTRIGHT	COUNTIFS+RIGHT+LEFT+FIND
3	COUNTIFSDATE	COUNTIFS+DATE
4	COUNTIFSCOUNTIF	COUNTIFS+COUNTIF
5	COUNTIF	COUNTIF
6	SUMPRODUCTEXACT	SUMPRODUCT+EXACT
7	COUNTIFSUMPRODUCTISNUMBERMATCH	SUMPRODUCT+ISNUMBER+COUNTIF+MATCH
8	COUNTIFSUMPRODUCT	SUMPRODUCT+COUNTIF
9	MATCHISNASUMPRODUCTCOUNTACOUNTIF	SUMPRODUCT+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

 

[Peter_SSs]

Hi Peter,

Thanks so much that after testing vba code, the expected results are perfectly matched.

You're welcome. Thanks for the follow-up.

 

[Lenard]

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]

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.

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

 

[Lenard]

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]

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]

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]

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.

 

[Peter_SSs]

No problem.