Convert a Find/Loop to an Array macro
if you don't have duplicates try:
Sub Find_List_cRows()
the macro is a little bit faster if you write the matches first into an
array:
Sub Find_List_cRows()
Dim aRows As Long, cRows As Long, i As Long
Dim aVal As Range
Dim varData As Variant, varOut() As Variant
Dim wsh As Worksheet
Application.ScreenUpdating = False
For Each wsh In Worksheets
With wsh
cRows = .Cells(.Rows.Count, "C").End(xlUp).Row
aRows = .Cells(.Rows.Count, "A").End(xlUp).Row
varData = .Range(.Cells(1, 3), .Cells(cRows, 3))
ReDim Preserve varOut(aRows - 1, 0)
For i = LBound(varData) To UBound(varData)
Set aVal = .Range("A:A").Find(What:=varData(i, 1), _
after:=.Range("A" & aRows), _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Not aVal Is Nothing Then varOut(aVal.Row - 1, 0) = aVal
Next 'i
.Range("B1").Resize(UBound(varOut) + 1) = varOut
.Range("B1:B" & aRows).SpecialCells(xlCellTypeBlanks) =
"missing"
End With
Next 'wsh
Application.ScreenUpdating = True
End Sub
Regards
Claus B.
Hi Claus,
I run the second (faster) code on a three page dozen row example, seems to work even with duplicates in both columns. And the "missing" texts seem correct to me.
I may not understand the duplicates situation you mention.
Howard
|