View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
L. Howard L. Howard is offline
external usenet poster
 
Posts: 852
Default 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