Give this a trial. Data in "A" in both files. Note the format of data has to maintained with a comma and space between words. HTH. Dave
Sub tested()
Dim FilDir As Object, Lastrow As Integer, cnt As Integer, Wrd As Variant, fso As Object
'data in "A1:A" & lastrow in both workbooks
With Sheets("Sheet1")
Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set fso = CreateObject("scripting.filesystemobject")
'***change File path to your file
Set FilDir = fso.GetFile(ThisWorkbook.Path & "\Datafiles\" & "test.xlsm")
workbooks.Open filename:=FilDir
For cnt = 1 To Lastrow
For Each Wrd In Split(workbooks(FilDir.Name).Sheets("Sheet1").Range("A" & cnt).Value, ", ")
If InStr(UCase(ThisWorkbook.Sheets("Sheet1").Range("A" & cnt).Value), UCase(Wrd)) = 0 Then
ThisWorkbook.Sheets("Sheet1").Range("A" & cnt).Value = _
ThisWorkbook.Sheets("Sheet1").Range("A" & cnt).Value & ", " & Wrd
End If
Next Wrd
Wrd = vbNullString
Next cnt
ThisWorkbook.Sheets("Sheet1").Range("A1:A" & Lastrow).Copy _
Destination:=workbooks(FilDir.Name).Sheets("Sheet1").Range("A" & 1)
Application.CutCopyMode = False
workbooks(FilDir.Name).Close SaveChanges:=True
Set FilDir = Nothing
Set fso = Nothing
Application.DisplayAlerts = False
Application.ScreenUpdating = False
End Sub