[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More
Experts Exchange Solution brought to you by
"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.
Learn the most important control and control categories that every architect and developer should include in their projects.
DeDupeRange Range("A1:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row)
Sub DeDupeRange(rngTarget As Range)
Dim rngCell As Range
For Each rngCell In rngTarget
rngCell.Value = DeDupeText(rngCell.Value)
Function DeDupeText(strText As String) As String
Dim arrWord() As String
Dim strWord As Variant
DeDupeText = ""
.CompareMode = vbTextCompare
arrWord = Split(strText, ",")
For Each strWord In arrWord
If Not .Exists(Trim(strWord)) Then
.Add Trim(strWord), 1
If DeDupeText = "" Then
DeDupeText = strWord
DeDupeText = DeDupeText & "," & strWord
Open in new window
Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.
Dim lngLastRow As Long
Dim lngRow As Long
Dim colWords As Collection
Dim strWords() As String
Dim lngIndex As Long
Dim lngNextRow As Long
Const DATA_COL = "A" ' Change as needed
Const FIRST_ROW = 1 ' Change as needed
lngLastRow = Range(DATA_COL & "1048576").End(xlUp).Row
lngNextRow = FIRST_ROW
For lngRow = FIRST_ROW To lngLastRow
Set colWords = New Collection
strWords = Split(Cells(lngRow, DATA_COL), ",")
For lngIndex = 0 To UBound(strWords)
On Error Resume Next
colWords.Add Trim(strWords(lngIndex)), Trim(strWords(lngIndex))
For lngIndex = 1 To colWords.Count
If lngIndex < colWords.Count Then
Cells(lngNextRow, DATA_COL) = Cells(lngNextRow, DATA_COL) & colWords(lngIndex) & ", "
Cells(lngNextRow, DATA_COL) = Cells(lngNextRow, DATA_COL) & colWords(lngIndex)
lngNextRow = lngNextRow + 1
Function getUniqueWords(ByVal vStr As String) As String
Dim str() As String
Dim i As Long
str = Split(Replace(Replace(vStr, Chr(10), ""), " ", ""), ",")
Set dict = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(str)
dict.Item(str(i)) = ""
If dict.Count > 0 Then getUniqueWords = Join(dict.keys, ", ")
From novice to tech pro — start learning today.
Premium members can enroll in this course at no extra cost.