Delete repeated words in every cells in a Range

Hello!
I have thousands of cells with repeated terms, and would like to delete the repeated/duplicate words in the cells without deleting the entire rows.

I found the following VBA code (below) on this forum that comes close to achieving this end but with some limitations that I need help with.
Here is an example of a cell content: Measles, Measles, Measles, Measles, Measles, Measles, Measles, Dengue, Dengue, Dengue, Dengue, Dengue, Dengue, Dengue

Running the code gives the following: Measles, , , , , , , Dengue, , , , , ,

But ideally, I would want to just have Measles, Dengue

Any help would be much appreciated. Thanks

Sub RemoveDupilcateWords()

    Dim Cell        As Range
    Dim Dict        As Object
    Dim FirstCell   As Range
    Dim Key         As String
    Dim LastCell    As Range
    Dim Matches     As Object
    Dim NewText     As String
    Dim RegExp      As Object
    Dim Rng         As Range
    Dim Text        As String
    Dim txtArray    As Variant
    Dim i As Long
    Dim j As Long
        Set FirstCell = Range("F2")
        Set LastCell = Cells(Rows.Count, FirstCell.Column).End(xlUp)
        Set Rng = Range(FirstCell, LastCell)
        
        If LastCell.Row < FirstCell.Row Then Exit Sub
        
            Set Dict = CreateObject("Scripting.Dictionary")
            
            Set RegExp = CreateObject("VBScript.RegExp")
            RegExp.Global = True
            RegExp.IgnoreCase = True
            RegExp.Pattern = "([^\,\;\.]+)"
            
            Application.ScreenUpdating = False
            
            For Each Cell In Rng
                Text = Cell
                Set Matches = RegExp.Execute(Text)
                If Matches.Count > 0 Then
                    For i = 0 To Matches.Count - 1
                        txtArray = Split(Matches(i), " ")
                            For j = 0 To UBound(txtArray)
                                Key = Trim(txtArray(j))
                                If Key <> "" Then
                                    If Not Dict.Exists(Key) Then
                                        Dict.Add Key, 1
                                    Else
                                        txtArray(j) = ""
                                    End If
                                End If
                            Next j
                        NewText = NewText & Join(txtArray, " ") & Mid(Text, Matches(i).FirstIndex + Matches(i).Length + 1, 1)
                    Next i
                    Cell = NewText
                    NewText = ""
                    Dict.RemoveAll
                End If
            Next Cell
            
            Application.ScreenUpdating = True
            
End Sub