I inserted a column for results like so:
-------------A------------- --B-- --------C--------
1 Keywords Location
2 reed.co.uk central london
3 reed recruitment city
4 reed jobs east london
5 reed accountancy north london
6 reed employment north west london
7 reeds south east london
8 www.reed.co.uk south west london
9 reeds recruitment west london
10 reed uk 18014 aberdeen
11 reed agency aboyne
12 reeds jobs alford
13 reed.com ballater
14 reed employment agency ellon
15 reed sign in fraserburgh
16 recruitment huntly
17 reed specialist recruitment insch
18 reed scientific inverurie
Then run this:
Sub x()
Dim iRow As Long
Dim cell As Range
Dim av As Variant
Dim v As Variant
Dim asWd() As String
Dim vsWd As Variant
Dim i As Long
With CreateObject("Scripting.Dictionary")
av = Range("C2", Cells(Rows.Count, "C").End(xlUp)).Value
iRow = Range("C2").Row
For Each v In av
If .Exists(v) Then
.Item(v) = .Item(v) & Format(iRow, ",0")
Else
.Add Key:=v, Item:=CStr(iRow)
End If
iRow = iRow + 1
Next v
Beep
av = WorksheetFunction.Transpose(Range("A2", Cells(Rows.Count, "A").End(xlUp)).Value)
For i = 1 To UBound(av)
asWd = Split(av(i))
av(i) = vbNullString
For Each vsWd In asWd
If .Exists(vsWd) Then
av(i) = av(i) & .Item(vsWd) & ","
End If
Next vsWd
If Len(av(i)) Then av(i) = Left(av(i), Len(av(i)) - 1)
Next i
End With
With Range("B2").Resize(UBound(av))
.NumberFormat = "@"
.Value = WorksheetFunction.Transpose(av)
End With
End Sub
Bookmarks