Extract the unique words from a cell

G

gohotels

New Member
Joined
May 10, 2012
Messages
7
Hi Everyone,

I have a list of phrases in column A, does anybody have a formula that I could paste into column B which would extract the unique words in the corresponding cell, so for example

A1. Very Very Very Very Very Very Big
A2. Red Red Red Blue Blue Blue Blue Yellow Green
A3. Yes Yes Yes Yes Yes Yes Yes Yes

would be transformed into

B1. Very Big (as "Very" and "Big" are the only 2 unique words)
B2. Red Blue Yellow Green
B3. Yes

Any help would be appreciated, Many Thanks!
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Sort by date Sort by votes
Hi.

I've a suggestion in 2 steps.

#1 Highlight the range and go via "Data" to "Text to Columns"
The Result = one word in one cell:

<table style="font-family:Calibri,Arial; font-size:10pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; " border="1" cellpadding="0" cellspacing="0"> <colgroup><col style="font-weight:bold; width:30px; "><col style="width:48.8px;"><col style="width:48.8px;"><col style="width:48.8px;"><col style="width:48.8px;"><col style="width:48.8px;"><col style="width:48.8px;"><col style="width:48.8px;"><col style="width:48.8px;"><col style="width:48.8px;"></colgroup><tbody><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td>
</td><td>A</td><td>B</td><td>C</td><td>D</td><td>E</td><td>F</td><td>G</td><td>H</td><td>I</td></tr><tr style="height:23px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">1</td><td style="text-align:center; ">Very</td><td style="text-align:center; ">Very</td><td style="text-align:center; ">Very</td><td style="text-align:center; ">Very</td><td style="text-align:center; ">Very</td><td style="text-align:center; ">Very</td><td style="text-align:center; ">Big</td><td>
</td><td>
</td></tr><tr style="height:23px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">2</td><td style="text-align:center; ">Red</td><td style="text-align:center; ">Red</td><td style="text-align:center; ">Red</td><td style="text-align:center; ">Blue</td><td style="text-align:center; ">Blue</td><td style="text-align:center; ">Blue</td><td style="text-align:center; ">Blue</td><td style="text-align:center; ">Yellow</td><td style="text-align:center; ">Green</td></tr><tr style="height:23px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">3</td><td style="text-align:center; ">Yes</td><td style="text-align:center; ">Yes</td><td style="text-align:center; ">Yes</td><td style="text-align:center; ">Yes</td><td style="text-align:center; ">Yes</td><td style="text-align:center; ">Yes</td><td style="text-align:center; ">Yes</td><td style="text-align:center; ">Yes</td><td>
</td></tr></tbody></table>
#2 Macrostart:
Code: 
Option Explicit
Public Sub gohotels()
Dim arrIn As Variant, L As Long, I As Integer
Dim out As Variant, a As Long, b As Integer
Dim myDic As Object
With Sheets("Sheet1") '[COLOR=Red]Your sheetname[/COLOR]
    arrIn = .Range("a1").CurrentRegion
    ReDim out(1 To UBound(arrIn), 1 To UBound(arrIn, 2))
    Set myDic = CreateObject("Scripting.Dictionary")
    For L = LBound(arrIn) To UBound(arrIn)
    myDic.RemoveAll
    a = a + 1
    b = 0
    For I = 1 To UBound(arrIn, 2)
    If arrIn(L, I) <> "" Then
    If Not myDic.exists(arrIn(L, I)) Then
    myDic(arrIn(L, I)) = 0
    b = b + 1
    out(a, b) = arrIn(L, I)
    End If
    End If
    Next
    Next
    .Range("a1").CurrentRegion = out
End With
End Sub
The Result =
<table style="font-family:Calibri,Arial; font-size:10pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; " border="1" cellpadding="0" cellspacing="0"> <colgroup><col style="font-weight:bold; width:30px; "><col style="width:48.8px;"><col style="width:48.8px;"><col style="width:48.8px;"><col style="width:48.8px;"><col style="width:48.8px;"><col style="width:48.8px;"><col style="width:48.8px;"><col style="width:48.8px;"><col style="width:48.8px;"></colgroup><tbody><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td>
</td><td>A</td><td>B</td><td>C</td><td>D</td><td>E</td><td>F</td><td>G</td><td>H</td><td>I</td></tr><tr style="height:23px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">1</td><td style="text-align:center; ">Very</td><td style="text-align:center; ">Big</td><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td></tr><tr style="height:23px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">2</td><td style="text-align:center; ">Red</td><td style="text-align:center; ">Blue</td><td style="text-align:center; ">Yellow</td><td style="text-align:center; ">Green</td><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td></tr><tr style="height:23px ;"><td style="font-size:8pt; background-color:#cacaca; text-align:center; ">3</td><td style="text-align:center; ">Yes</td><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td><td>
</td></tr></tbody></table>
 
Last edited:
Upvote 0
Or, using Excel 2007/2010 remove duplicates functionality:

Code: 
Sub Macro3()
    Application.ScreenUpdating = False
    For Each Rng In Columns(1).SpecialCells(2, 2)
        With Range("H1")
            sq = Split(Trim(Rng.Text))
            .Resize(UBound(sq) + 1) = Application.Transpose(sq)
            .CurrentRegion.RemoveDuplicates 1, xlNo
            If .Offset(1) = "" Then
                Rng.Value = .Value
            Else
                sq = Application.Transpose(.CurrentRegion.Value)
                Rng.Resize(, UBound(sq)) = sq
            End If
            .EntireColumn.ClearContents
        End With
    Next
    Columns.AutoFit
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Or for a non-VBA solution, first do text to columns and then copy>paste special>transpose and then remove duplicates...
 
Upvote 0
I am able to perform the first part of the task so that one word appears in one cell.

Regarding the codes that you have supplied, when I paste them into the cell nothing happens, the text just gets pasted and thats it.

Do I need to paste the code into a specific area?

Please forgive my lack of knowledge on this subject!
 
Upvote 0
Did you try my idea? Highlight your data, hit CTRL-C. Select a blank area and right click, choose paste special, choose transpose. Then delete your original data and use Excel's Remove Duplicates feature.
 
Upvote 0
gohotels said:
Hi Everyone,

I have a list of phrases in column A, does anybody have a formula that I could paste into column B which would extract the unique words in the corresponding cell, so for example

A1. Very Very Very Very Very Very Big
A2. Red Red Red Blue Blue Blue Blue Yellow Green
A3. Yes Yes Yes Yes Yes Yes Yes Yes

would be transformed into

B1. Very Big (as "Very" and "Big" are the only 2 unique words)
B2. Red Blue Yellow Green
B3. Yes

Any help would be appreciated, Many Thanks!
Click to expand...
Hi,

If you don't mind trying a macro, just run this one. It should work fine as it is with any version of Excel for Windows.
Code: 
Sub uniquewords()
Dim d As Object, c, e
Set d = CreateObject("scripting.dictionary")
For Each c In Range(Cells(1, 1), Cells(Rows.Count, 1).End(3))
    d.RemoveAll
    For Each e In Split(c, " ")
        d(e) = 0
    Next
c.Offset(, 1) = Join(d.keys)
Next c
End Sub
 
Upvote 0
Here's a VBA solution that works on your sample - we could eliminate duplicates in the array should it become necessary:

Code: 
Sub BerryBerry(): Dim S As String, A(25) As String
Dim i As Integer, j As Integer, k As Integer
If ActiveCell = "" Then Exit Sub
S = Trim(ActiveCell)
For k = 1 To 25
LoopWithin:
i = InStr(1, S, " ")
If i Then
A(k) = Mid(S, 1, i - 1)
S = Mid(S, i + 1, Len(S) - i)
If A(k) = A(k - 1) Then GoTo LoopWithin
Else
A(k) = S: S = "": Exit For: End If
Next k
For i = 1 To k
S = S & " " & A(i)
Next i
ActiveCell.Offset(0, 1) = S
ActiveCell.Offset(1, 0).Select
BerryBerry
End Sub

<table border="0" cellpadding="0" cellspacing="0" width="350"><colgroup><col width="350"></colgroup><tbody><tr height="17"> <td style="height:12.75pt;width:263pt" height="17" width="350">You can't do one thing. XLAdept</td> </tr></tbody></table>
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
Stocktake of Barcoded Inventory in Excel using a Barcode Scanner
Replies
2
Views
122
Kobus Horn
K
P
  • Question Question
Formula to locate and remove outlying values from a large data set
Replies
3
Views
169
hagia_sofia
hagia_sofia
willow1985
  • Question Question
Assistance with finding top 2 repeated values based on 2 criteria (LET,UNIQUE,FILTER,TAKE,SORT,HSTACK,COUNTIF formula)
Replies
3
Views
191
Cubist
Cubist
K
  • Question Question
Make last word proper
Replies
3
Views
173
Eric W
Eric W
D
  • Question Question
Split and search for values in cell
Replies
6
Views
304
Fluff
Fluff

Forum statistics

Threads
1,223,893
Messages
6,175,249
Members
452,623
Latest member
Techenthusiast

Share this page

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
Back
Top