Here's what works for me. It takes a while to go through each cell in
colA, but takes less than a minute to process all 18513 entries.

Sub FindMatches()
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim vVal As Variant, rng As Range
Dim lSect1Cols As Long, lSect2Cols As Long
Dim lSect1Rows As Long, lSect2Rows As Long
Dim lNextRow As Long, i As Long

'Hide screen activity
Application.ScreenUpdating = False

Set wksSource = ActiveWorkbook.ActiveSheet
Set wksTarget = ActiveWorkbook.Sheets.Add(After:=ActiveSheet)
wksTarget.Name = wksSource.Name & "_2"

With wksSource
lSect1Cols = .Range("$A$1:$N$1").Columns.Count
lSect2Cols = .Range("$O$1:$AC$1").Columns.Count
lSect1Rows = .Range("$A$1").End(xlDown).Row
' lSect2Rows = .Range("$O$1").End(xlDown).Row

For i = 1 To lSect1Rows
vVal = .Cells(i, 1).Value
Set rng = .Range("$O:$O").Find(what:=vVal)
If Not rng Is Nothing Then '//we have a match
Application.StatusBar = "Found match for " & vVal
lNextRow = lNextRow + 1
.Cells(i, 1).Resize(1, lSect1Cols).Copy _
Destination:=wksTarget.Cells(lNextRow, 1)
rng.Resize(1, lSect2Cols).Copy _
Destination:=wksTarget.Cells(lNextRow, lSect1Cols + 1)
End If
Next
End With
With wksTarget
.UsedRange.EntireColumn.AutoFit: .Activate
End With
Application.StatusBar = "" '//reset
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc