Split words in a cell range into a cell each [UDF]
This post describes how to split words in a cell range into a cell each using a custom function. I hope this picture explains it all:
The cell range is A1:A10 and contain words.
The array formula in C2:C27 contains an udf:
- Select all the cells to be filled, C2:C27
- Type the array formula SplitWords($A$1:$A$10) into the formula bar.
How to create an array formula
- Copy (Ctrl + c) and paste (Ctrl + v) array formula into formula bar.
- Press and hold Ctrl + Shift.
- Press Enter once.
- Release all keys.
User defined function: Read Rick Rothstein's (MVP - Excel) comment!
Function SplitWords(rng As Range) As Variant()
Dim x As Variant, Wrds() As Variant, Cells_row As Long
Dim Cells_col As Long, Words As Long, y() As Variant
ReDim y(0)
Wrds = rng.Value
For Cells_row = LBound(Wrds, 1) To UBound(Wrds, 1)
For Cells_col = LBound(Wrds, 2) To UBound(Wrds, 2)
x = Split(Wrds(Cells_row, Cells_col))
For Words = LBound(x) To UBound(x)
y(UBound(y)) = x(Words)
ReDim Preserve y(UBound(y) + 1)
Next Words
Next Cells_col
Next Cells_row
SplitWords = Application.Transpose(y)
End Function
Where to copy the code
-
Click "Developer" tab on the ribbon
How to enable developer tab on the ribbon - Click "Visual Basic" button
- Insert a new module
- Copy this udf example and paste it into new module
Split data across multiple sheets [VBA]
In this post I am going to show how to create a new sheet for each airplane using vba. The [โฆ]
Text to columns: Split words in a cell [Array formula]
This blog article describes how to split strings in a cell with space as a delimiting character, like Text to [โฆ]
Split values equally into groups
Question: How do I divide values equally into groups (3 lists or less)? This post shows you two different approaches, [โฆ]
Rearrange values based on category [VBA]
In this post I am going to rearrange values from a list into unique columns. Before: After: The code Download [โฆ]
How to count word frequency in a cell range [UDF]
This user defined function creates a unique distinct list of words and how many times they occur in the selected [โฆ]
Extract unique distinct values from a filtered Excel defined Table [UDF and Formula]
Robert Jr asks: Oscar, I am using the VBA code & FilterUniqueSort array to generate unique lists that drive Selection [โฆ]
List files in a folder and subfolders [UDF]
This article demonstrates a user defined function that lists files in a ggiven folder and subfolders. A user defined function is [โฆ]
Split values equally into groups
Question: How do I divide values equally into groups (3 lists or less)? This post shows you two different approaches, [โฆ]
13 Responses to โSplit words in a cell range into a cell each [UDF]โ
Leave a Reply
How to comment
How to add a formula to your comment
<code>Insert your formula here.</code>
Convert less than and larger than signs
Use html character entities instead of less than and larger than signs.
< becomes < and > becomes >
How to add VBA code to your comment
[vb 1="vbnet" language=","]
Put your VBA code here.
[/vb]
How to add a picture to your comment:
Upload picture to postimage.org or imgur
Paste image link to your comment.
English
Spanish
You have way more lines of code in your UDF than you need. Give this UDF a try instead...
Function SplitWords(Rng As Range) As Variant
SplitWords = WorksheetFunction.Transpose(Split(Join( _
WorksheetFunction.Transpose(Rng))))
End Function
The function is actually a one-liner, but I posted it with a line continuation so that your comment processor wouldn't word-wrap it at a "funny" location.
>> SplitWords($A$1:$A$10) + CTRL + SHIFT + ENTER.
>> Copy cell C2 and paste it down as far as needed.
By the way, is the above really how you implemented your UDF? I can't get your or my version of the function to work correctly using the above procedure... I am not sure what I am missing. Instead, I select all the cells to be filled, then type the formula into the Formula Bar and press CTRL+SHIFT+ENTER... doing it that way automatically fills the selected range correctly.
Rick Rothstein (MVP - Excel),
Many thanks!!
You will probably find more lengthy code here in the future, I was planning on blog posts like "Unique distinct words from a cell range (udf)" and "Duplicate words from a cell range (udf)". But I am sure I canยดt write genious code like that. I am grateful, I have learned new things today!
You are also right about how to implement the udf. Thanks for your contribution!
@Oscar,
Below is a version of the SplitWords UDF that may be more useful than either of the two UDFs that we posted earlier. The problem with our current UDFs is that if you select a larger range to put the UDF formulas in than is required for the current range being processed, you get errors displayed in the cells that do not get populated with words. There are two reasons you might want to select a larger range of cells to populate with the UDF formula... one, you don't know how many cells to select because you don't know where the end of the split word list will be; two, you want to pass a larger range to the UDF so that you can dynamically handle new rows of data in the future and you want to populate the UDF formula through enough cells to handle such a future expansion to that original list. Using your sample worksheet with its 10 rows of data, replace whatever SplitWords UDF you current have with this one...
Function SplitWords(Rng As Range) As Variant
Dim List As String, Words As Variant
Application.Volatile
With WorksheetFunction
List = .Trim(Join(.Transpose(Rng)))
Words = Split(List)
List = List & Space(Application.Caller.Count - UBound(Words))
SplitWords = .Transpose(Split(List))
End With
End Function
Now select, say, the range C2:C60 (this should be large enough to handle new words added to the list) and then put this formula in the Formula Bar...
=SplitWords(A1:A20)
and commit the formula using CTRL+SHIFT+ENTER (notice the range argument covers more cells than the number of cells with data in them... this is to be able to handle future entries in A11, A12, etc.). Okay, after you have done the above, the first thing to notice is that there are no errors being displayed in the cells that do not get populated with words. The second thing to notice is you can now fill in new data in cells A11 thru A20 and those words will get placed in the list in cells C2:C60. On top of that, if you skip rows in the word list range (that is, with your existing list of words in A1 thru A10, put "one two three" in, say, A18), the intervening blank rows will not be displayed in the resulting list of individual words in Column C. Hopefully, you and your readers will find this new version of the SplitWords UDF useful.
@Oscar,
Whoops! I left a line of code in there from previous testing that can be removed. The Application.Volatile statement is not needed (that was left over from earlier attempts to correct code that was not working correctly). The UDF you and your readers should use is this one...
Function SplitWords(Rng As Range) As Variant
Dim List As String, Words As Variant
With WorksheetFunction
List = .Trim(Join(.Transpose(Rng)))
Words = Split(List)
List = List & Space(Application.Caller.Count - UBound(Words))
SplitWords = .Transpose(Split(List))
End With
End Function
Oh, by the way... I'd like to take a crack at the "Unique distinct words from a cell range (udf)" and "Duplicate words from a cell range (udf)" code that you mentioned, but I have a question as to what you want for the final output in that first one... Is the unique distinct word list to be only those words that do not have a duplicate elsewhere in the list, or a list of all words but only listed one time (without their duplicates)? If you do not want me to post these before you had a chance to try your hand at them, just say so. If that will be the case, then you can send me your email address and I'll foward any solutions I come up with directly to you so that you can incorporate them in your future article if you wish. Let me know either way how you want me to handle this.
@Oscar,
Sigh! It seems I omitted a boundary check. My lastest UDF will produce a series of #VALUE! errors if the selected range is not large enough to house all the words in the split out list. Here is the corrected code...
Function SplitWords(Rng As Range) As Variant
Dim List As String, Words As Variant
With WorksheetFunction
List = .Trim(Join(.Transpose(Rng)))
Words = Split(List)
If Application.Caller.Count > UBound(Words) Then
List = List & Space(Application.Caller.Count - UBound(Words))
End If
SplitWords = .Transpose(Split(List))
End With
End Function
Rick Rothstein (MVP - Excel),
I would be more than happy if you would like to try to solve those problems. Actually there are three problems:
Unique - Words occurring only once.
Unique distinct - List of all words but only listed one time without their duplicates
Duplicate - Words having duplicates.
You can post or email your solutions.
Thanks for all your work!!
@Oscar,
Here are the functions I have developed. I am going to sleep now, so I have not had time to test them fully, but I am pretty sure they work. Note that there is an optional argument allowing you to specify whether the matches will be case sensitive or not... the default is False, that is, to not match case so that One, one and ONE would be considered the same... specifying True for the optional argument would mean those three words would be considered as being different. These function are array functions and should be implemented by selecting the range to be filled (you can select more cells that will be necessary so that the list will dynamically expand if more words are added) and then committed by pressing CTRL+SHIFT+ENTER. You can specify a larger range for the first argument so that additional cells can be filled with words later on. Okay, here are the functions...
Function DuplicateWords(Rng As Range, Optional _
MatchCase As Boolean) As Variant
Dim X As Long, WordCount As Long, List As String
Dim Duplicates As Variant, Words() As String
List = WorksheetFunction.Trim(Join(WorksheetFunction.Transpose(Rng)))
Words = Split(List)
For X = 0 To UBound(Words)
If MatchCase Then
If UBound(Split(" " & UCase(List) & " ", _
" " & UCase(Words(X)) & " ")) > 1 Then
Duplicates = Duplicates & StrConv(Words(X), vbProperCase) & " "
List = Replace(List, Words(X), "")
End If
Else
If UBound(Split(" " & List & " ", " " & Words(X) & " ")) > 1 Then
Duplicates = Duplicates & Words(X) & " "
List = Replace(List, Words(X), "")
End If
End If
Next
Duplicates = WorksheetFunction.Trim(Duplicates)
Words = Split(Duplicates)
If Application.Caller.Count > UBound(Words) Then
Duplicates = Duplicates & Space(Application.Caller.Count - UBound(Words))
End If
DuplicateWords = WorksheetFunction.Transpose(Split(Duplicates))
End Function
Function UniqueWords(Rng As Range, Optional MatchCase As Boolean) As Variant
Dim X As Long, WordCount As Long, List As String
Dim Uniques As Variant, Words() As String
List = WorksheetFunction.Trim(Join(WorksheetFunction.Transpose(Rng)))
Words = Split(List)
For X = 0 To UBound(Words)
If MatchCase Then
If UBound(Split(" " & UCase(List) & " ", _
" " & UCase(Words(X)) & " ")) = 1 Then
Uniques = Uniques & StrConv(Words(X), vbProperCase) & " "
List = Replace(List, Words(X), "")
End If
Else
If UBound(Split(" " & List & " ", " " & Words(X) & " ")) = 1 Then
Uniques = Uniques & Words(X) & " "
List = Replace(List, Words(X), "")
End If
End If
Next
Uniques = WorksheetFunction.Trim(Uniques)
Words = Split(Uniques)
If Application.Caller.Count > UBound(Words) Then
Uniques = Uniques & Space(Application.Caller.Count - UBound(Words))
End If
UniqueWords = WorksheetFunction.Transpose(Split(Uniques))
End Function
Function ListOfWords(Rng As Range, Optional MatchCase As Boolean) As Variant
Dim X As Long, Index As Long, List As String
Dim Words() As String, LoW As Variant
With WorksheetFunction
Words = Split(.Trim(Join(.Transpose(Rng))))
LoW = Split(Space(.Max(UBound(Words), Application.Caller.Count) + 1))
For X = 0 To UBound(Words)
If InStr(1, Chr(1) & List & Chr(1), Chr(1) & Words(X) & _
Chr(1), 1 - Abs(MatchCase)) = 0 Then
List = List & Chr(1) & Words(X)
LoW(Index) = Words(X)
Index = Index + 1
End If
Next
ListOfWords = .Transpose(LoW)
End With
End Function
@Oscar,
I think I must have been sleepier than I thought when I concocted those macros... there appear to be some minor problems with them... give me some time to investigate and straighten them out.
@Oscar,
Okay, I think I have everything straightened out now. I'll list the code in a moment; but, to make things easier, here is a link where you can download a workbook with some sample data and the all the codes already implemented (and formatted so they are more readable that the codes listed below. That link is...
https://www.filefactory.com/file/b361f7f/n/Word_Listing_Code.xls
I noticed in my previous listings that when I didn't put line continuations on lines that were long enough to word-wrap, that copying those lines from your comment processor's listing "straightened out" the word-wrapped lines; so, I have decided not to try and insert any line continuations assuming you and your readers will be copy/pasting my code into a VB editor code window. So below are my macros for your three stated needs...
Unique - Words occurring only once.
Unique distinct - List of all words but only listed one time without their duplicates.
Duplicate - Words having duplicates.
Let me know how they work out for you or (hopefully not) about any bugs you might find in them...
Function DuplicatedWords(Rng As Range, Optional CaseSensitive As Boolean) As Variant
Dim X As Long, WordCount As Long, List As String, Duplicates As Variant, Words() As String
List = WorksheetFunction.Trim(Replace(Join(WorksheetFunction.Transpose(Rng)), Chr(160), " "))
Words = Split(List)
For X = 0 To UBound(Words)
If CaseSensitive Then
If UBound(Split(" " & List & " ", " " & Words(X) & " ")) > 1 Then
Duplicates = Duplicates & Words(X) & " "
List = Replace(List, Words(X), "", 1, -1, vbBinaryCompare)
End If
Else
If UBound(Split(" " & UCase(List) & " ", " " & UCase(Words(X)) & " ")) > 1 Then
Duplicates = Duplicates & StrConv(Words(X), vbProperCase) & " "
List = Replace(List, Words(X), "", 1, -1, vbTextCompare)
End If
End If
Next
Duplicates = WorksheetFunction.Trim(Duplicates)
Words = Split(Duplicates)
If Application.Caller.Count > UBound(Words) Then
Duplicates = Duplicates & Space(Application.Caller.Count - UBound(Words))
End If
DuplicatedWords = WorksheetFunction.Transpose(Split(Duplicates))
End Function
Function UniqueWords(Rng As Range, Optional CaseSensitive As Boolean) As Variant
Dim X As Long, WordCount As Long, List As String, Uniques As Variant, Words() As String
List = WorksheetFunction.Trim(Replace(Join(WorksheetFunction.Transpose(Rng)), Chr(160), " "))
Words = Split(List)
For X = 0 To UBound(Words)
If CaseSensitive Then
If UBound(Split(" " & List & " ", " " & Words(X) & " ")) = 1 Then
Uniques = Uniques & Words(X) & " "
List = Replace(List, Words(X), "")
End If
Else
If UBound(Split(" " & UCase(List) & " ", " " & UCase(Words(X)) & " ")) = 1 Then
Uniques = Uniques & StrConv(Words(X), vbProperCase) & " "
List = Replace(List, Words(X), "")
End If
End If
Next
Uniques = WorksheetFunction.Trim(Uniques)
Words = Split(Uniques)
If Application.Caller.Count > UBound(Words) Then
Uniques = Uniques & Space(Application.Caller.Count - UBound(Words))
End If
UniqueWords = WorksheetFunction.Transpose(Split(Uniques))
End Function
Function ListOfWords(Rng As Range, Optional CaseSensitive As Boolean) As Variant
Dim X As Long, Index As Long, List As String, Words() As String, LoW As Variant
With WorksheetFunction
Words = Split(.Trim(Replace(Join(.Transpose(Rng)), Chr(160), " ")))
LoW = Split(Space(.Max(UBound(Words), Application.Caller.Count) + 1))
For X = 0 To UBound(Words)
If InStr(1, Chr(1) & List & Chr(1), Chr(1) & Words(X) & Chr(1), 1 - Abs(CaseSensitive)) = 0 Then
List = List & Chr(1) & Words(X)
If CaseSensitive Then
LoW(Index) = Words(X)
Else
LoW(Index) = StrConv(Words(X), vbProperCase)
End If
Index = Index + 1
End If
Next
ListOfWords = .Transpose(LoW)
End With
End Function
And, to keep all the code in one place, here is my last posted SplitWord macro...
Function SplitWords(Rng As Range) As Variant
Dim List As String, Words As Variant
With WorksheetFunction
List = .Trim(Replace(Join(.Transpose(Rng)), Chr(160), " "))
Words = Split(List)
If Application.Caller.Count > UBound(Words) Then
List = List & Space(Application.Caller.Count - UBound(Words))
End If
SplitWords = .Transpose(Split(List))
End With
End Function
All of these macros share the same functionality; namely, that one, you can select far more cells to load the formulas in than are required by the list (the empty text string will be displayed for cells not having an entry)... two, you can specify a larger range than the there are filled in cells as the argument to these macros to allow for future entries in the column... and three, for all but the SplitWords macro, you can specify whether the listing is to be case sensitive or not via the optional second argument with the default value being FALSE, meaning duplicated entries with different casing (like One, one, ONE, onE, etc.) will all be treated as if they were the same word with the same spelling... if you pass TRUE for that optional second argument, then those words would all be treated as if they were different words. One note... for all the "Case Insensitive" listing, the words are listed in Proper Case (first letter upper case, remaining letters lower case), the reason being if you had One, one and ONE then there is not reason to prefer one version over another, so I solve the problem by using Proper Case throughout. And, finally, as a reminder for your readers, these macros are implemented by first selecting a range to fill (remember, you can select more than will be required for you existing list in case more data is added later), then clicking in the Formula Bar and typing the UDF formula and then, finally, commiting the formula using CTRL+SHIFT+ENTER (not just Enter by itself).
Rick Rothstein (MVP - Excel),
Great work!! I will post your code, explanations and your name in future blog articles.
Now I need to understand your code.
Thanks!!
Edited: 2010-09-13 10:52
I guess your "Great work" comment meant my macros passed your testing. As for understanding the code.. please feel free to ask for any explanations you might need.
I was curious if you ever thought of changing the structure
of your website? Its very well written; I love what youve got to
say. But maybe you could a little more in the way of content so people could
connect with it better. Youve got an awful lot of text for only
having 1 or two pictures. Maybe you could space it out better?