MS Excel: Find duplicate words with in a cell and paste to next column

I had around 20k rows filled with descriptions in column A. The words are delimited with spaces. I needed to find repeated words (not letters) available in column A and paste them in column B as depicted below.

One of my friend helped me to achieve this task.

Sub FindDuplicates()
    Dim i As Long
    Dim j As Integer
    Dim k As Integer
    Dim WS As Worksheet
    Dim WordArr As Variant
    Dim DubStr As String
    Dim WordCount As Integer

    Set WS = ActiveSheet

    'Loop cells
    For i = 2 To WS.Cells(Rows.Count, 1).End(xlUp).Row
        'Split cell words into array
        WordArr = Split(WS.Cells(i, 1).Value, " ")

        'Loop through each word in cell
        For j = LBound(WordArr) To UBound(WordArr)
            WordCount = 0

            'Count the occurrences of the word
            For k = LBound(WordArr) To UBound(WordArr)
                If UCase(WordArr(j)) = UCase(WordArr(k)) Then
                    WordCount = WordCount + 1
                End If
            Next k

            'Output duplicate words to string
            If WordCount > 1 And InStr(1, DubStr, WordArr(j)) = 0 Then
                DubStr = DubStr & WordArr(j) & " | "
            End If
        Next j

        'Paste string in column B
        WS.Cells(i, 2).Value = Trim(DubStr)
        DubStr = ""
        Erase WordArr
    Next i
End Sub