Find and highlight similar cells in a column

Hello Pedro,

This macro will place the groups on the active worksheet starting in cell "E2". There is button on the sheet to run the macro. Each group is separated by a blank line.

Option Explicit

Sub GroupNames()

  Dim Cell As Range
  Dim Dict As Object
  Dim I As Long
  Dim Key As Variant
  Dim NameList As Variant
  Dim R As Long
  Dim RegExp As Object
  Dim Rng As Range
  Dim RngEnd As Range
  Dim Text As String
  Dim Wks As Worksheet
  
    Set Wks = ActiveSheet
    
    Set Rng = Wks.Range("A2")
    Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
    If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = Wks.Range(Rng, RngEnd)
    
    Set Dict = CreateObject("Scripting.Dictionary")
    Dict.CompareMode = vbTextCompare
    
    Set RegExp = CreateObject("VBScript.RegExp")
    RegExp.IgnoreCase = True
    RegExp.Pattern = "(\w+)(?:\s|\,\s)(\w+)(\s*.*)"
    
    
      For Each Cell In Rng
        Text = Trim(Cell.Value)
        If Text <> "" Then
           I = InStr(1, Text, ",")
           If I > 0 Then
              Key = RegExp.Replace(Text, "$2 $1")
           Else
              Key = RegExp.Replace(Text, "$1 $2")
           End If
           
           If Not Dict.Exists(Key) Then
              Dict.Add Key, Text
           Else
              Dict(Key) = Dict(Key) & "|" & Text
           End If
        End If
      Next Cell
      
    For Each Key In Dict.Keys
      NameList = Split(Dict(Key), "|")
      Wks.Range("E2").Offset(R, 0).Resize(UBound(NameList) + 1, 1) = WorksheetFunction.Transpose(NameList)
      R = R + UBound(NameList) + 2
    Next Key
    
End Sub