Macro problem: trying to create a list of most common phrases

This week was another one of those discouraging week - I couldn't really solve anything useful and everything takes me so long.

I keep encountering the need to create a list of the most common phrases - not words, phrases - such as unit names or vendor names, etc. Every time I do a data download, I find I have to create such a list and each time I do so, it takes me a while. So now I'm trying to see if I can build a macro that will get me part of the way there. I have no illusions of getting all the way there but I would like to develop something that will cut down on the time.

This recurring question is why I have delved into the question of arrays and array formulas. They have interesting possibilities but right now they are not getting me there.

So now, I'm trying another tactic: some combination of macro and formulas. I already have a macro to gather up the separate downloads and combine them into one big file. And I have another macro that can create a list of phrases that have show up multiple times in the download. The problem is the download test was for 10 rows; the real file has 2360 rows which was briefly tested before being aborted after 30 minutes.

To the right is a part of the macro - a function macro that is called by the main macro. It acts as a function comparing two cells (str1 and str2) that contains text and looks to see if the two texts has any matching word or phrases. If there is a match, the function lists the phrases.

Below is a part of the macro - a function macro that is called by the main macro. It acts as a function comparing two cells (str1 and str2) that contains text and looks to see if the two texts has any matching word or phrases. If there is a match, the function lists the phrases.

Function DupeWord(str1 As String, str2 As String) As String
Dim vArr1
Dim vArr2
Dim vTest
Dim lngCnt As Long

vArr1 = Split(Replace(str1, ":", "-"), "-
vArr2 = Split(Replace(str2, ":", "-"), "-")
On Error GoTo strExit

For lngCnt = LBound(vArr1) To UBound(vArr1)
vTest = Application.Match(vArr1(lngCnt), vArr2, 0)
If Not IsError(vTest) Then DupeWord = DupeWord & vArr1(lngCnt) & " "
Next lngCnt

If Len(DupeWord) > 0 Then
DupeWord = Left$(DupeWord, Len(DupeWord) - 1)
Else
strExit:
DupeWord = "No Matches!"
End If

End Function