List repeated words in single cell excel

Hi Experts -
In continuity with my previous question of removing duplicates, I am posting this question. I have searched on the web and found many codes to remove the single cell duplicates, but I don't want to remove but list those words using excel and vba. The conditions are as below:

1. Immediate duplicates should be listed in adjacent column.
2. If no immediate duplicates are found, but the words are repeated in the sentence, it should be also be listed but in another column.
3. To ignore certain words specified by the user as a list in another sheet only if they are not "Immediate duplicates"
4. If group of words to compare is specified result should be as shown in the attached file.

Thanks
Repeated_Values_Single_Cell.xlsx
Rocutana RimAsked:
Who is Participating?
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
In the string "Raw Apple Raw Apple is Very tasty.", "Raw Apple" is not immediate repeating words as Raw Apple is a sentence not a word.

BTW in the attached click the button on Sheet1 to run the macro present on Module1 to see if this is something you can work with.

Sub FindDuplicated()
Dim rng As Range, cell As Range
Dim str() As String, tstr() As String
Dim i As Long, lr As Long, j As Long
Dim ignWord As String, resStr As String
lr = Cells(Rows.Count, 3).End(xlUp).Row
Set rng = Range("C2:C" & lr)
Range("A2:A" & lr).ClearContents
Range("D2:D" & lr).ClearContents
ignWord = Range("A9").Value
For Each cell In rng
   str() = Split(Replace(cell.Value, ".", ""), " ")
   tstr() = Split(Replace(cell.Value, ".", "") & " ^", " ")
   For i = 0 To UBound(str)
      If InStr(ignWord, str(i)) = 0 Then
         If str(i) = tstr(i + 1) Then
            If InStr(cell.Offset(0, 1).Value, str(i)) = 0 Then
               cell.Offset(0, 1).Value = cell.Offset(0, 1).Value & str(i) & " "
            End If
         Else
            If InStr(cell.Offset(0, -2).Value, str(i)) = 0 And InStr(cell.Offset(0, 1).Value, str(i)) = 0 And InStr(resStr, str(i)) = 0 Then
               If Len(Replace(cell.Value, str(i), "")) <> Len(cell.Value) - Len(str(i)) And Len(str(i)) > 1 Then
                  If resStr = "" Then
                           resStr = str(i)
                        Else
                           resStr = resStr & " | " & str(i)
                        End If
                     End If
                  End If
               End If
            End If
   Next i
   If resStr <> "" Then
      cell.Offset(0, -2).Value = resStr
   End If
   resStr = ""
Next cell
End Sub

Open in new window

Repeated_Values_Single_Cell.xlsm
0
 
Rocutana RimAuthor Commented:
Thanks Neeraj for the macro. It is fine. I am sorry if I am asking for more but please bear with me.

1. Can this line 'ignWord = Range("A9").Value' be modified to take a complete column in another sheet but one condition is that it should consider only whole words and should ignore for words which are part of the other word. eg. Haris (is should not be ignored).

2. Can it be made case sensitive and to accept spaces. (eg. Is vs is vs " is ")

3. Please check if the 4th condition can be done.

I know that 'Raw apple' is not an immediate repeated word, but sometimes in our data 'Columbia industries Columbia industries' will be in single cell, so I asked for that specific condition. Checking the repeated words column towards left will become very difficult for large data.

Also, Can this be done using regular expressions. If possible can you incorporate the above code in one module & regex in the 2nd module for me.

Thanks for your help
0
 
Rocutana RimAuthor Commented:
@Neeraj - I will close the question as of now and select your 1st answer as best solution, but kindly go through my previous comment and help me out with this.

Thank you
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.