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
|