View Single Post
  #1   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

This works but is too slow as you would expect. Fine for the two dozen +/- rows I am testing on. Tried the ole Array caper but far as I could get was writing column C into an array and a msgbox showing how many elements were in the array.

I have old list in column A. New list is in column C.

List items look like this CVT07DR, ASC99YT...

Taking each C list item and find a match for it in A list, when found it goes in column B next to its match in A. Take next item on C list and do the same until all of C list has been processed.

It will be normal for there to be something like six identical A list items and in the C list there are only four like items to fill into column B, so there will be two blank B cells for those two items. (The identical A list items will not always be consecutive rows, all could be rows apart from each other)

So after C list has been processed, there will be blanks in column B which are then filled with text "missing".

A common number of rows is 400~ to 700~. There are also about 26 worksheets but I think a "for each sheet in this workbook..." could be handled by me if I is confirmed that all the sheet are formatted the same and there is actually a need to go workbook wide. Single sheet is fine at present.

Thanks,
Howard

Sub Find_List_cRows()

Dim bRows As Long, cRows As Long
Dim cRng As Range, cVal As Range, aVal As Range

Application.ScreenUpdating = False

cRows = Cells(Rows.Count, "C").End(xlUp).Row


Set cRng = Range(Cells(1, 3), Cells(cRows, 3)) '.Value

For Each cVal In cRng

Set aVal = Sheets("Sheet1").Range("A:A").Find(What:=cVal, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not aVal Is Nothing Then

If aVal.Offset(, 1) = "" Then
aVal.Offset(, 1) = cVal
End If

Else

End If

Next 'i

bRows = Cells(Rows.Count, "B").End(xlUp).Row

With Range("B1:B" & bRows).SpecialCells(xlCellTypeBlanks)
.FormulaR1C1 = "missing"
End With

Application.ScreenUpdating = True

End Sub