On Jan 30, 1:34*pm, GS wrote:
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 athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

I ran your Macro but there are no results (my spreadsheet is empty).