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

Convert a Find/Loop to an Array macro
 

Hi Howard,

Am Sun, 17 Apr 2016 02:15:54 -0700 (PDT) schrieb L. Howard:

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.

if you don't have duplicates try:

Sub Find_List_cRows()

Dim aRows As Long, cRows As Long, i As Long
Dim aVal As Range
Dim varData 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))

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 aVal.Offset(, 1) = aVal
Next 'i
.Range("B1:B" & aRows).SpecialCells(xlCellTypeBlanks) =
"missing"
End With

Next 'wsh
Application.ScreenUpdating = True

End Sub

If you have duplicates post here in which column these duplicates can
occure. If they are in Column A you have to use FindNext. If they are in
column C then must be created unique values first.


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Convert a Find/Loop to an Array macro
 

Hi again,

Am Sun, 17 Apr 2016 11:48:17 +0200 schrieb Claus Busch:

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.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Convert a Find/Loop to an Array macro
 

If you have duplicates post here in which column these duplicates can
occure. If they are in Column A you have to use FindNext. If they are in
column C then must be created unique values first.


Regards
Claus B.


There could duplicates in both column A and C.

Say something like six ADR09DR's in column A while column C has only three. So there would be three blanks in column B for that item number.

Howard

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

Convert a Find/Loop to an Array macro
 

Hi Howard,

Am Sun, 17 Apr 2016 04:05:10 -0700 (PDT) schrieb L. Howard:

I may not understand the duplicates situation you mention.

if you check the output you will find out that it is not correct. The
duplicates are not correctly handled.
It is easier to do it with a formula.
Try:

Sub Find_List_cRows()

Dim aRows As Long, cRows As Long
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
With .Range("B1:B" & aRows)
.Formula = "=IF(COUNTIF(C1:$C" & cRows &
",A1)0,A1,""missing"")"
.Value = .Value
End With
End With
Next 'wsh
Application.ScreenUpdating = True

End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Convert a Find/Loop to an Array macro
 

On Sunday, April 17, 2016 at 4:19:27 AM UTC-7, Claus Busch wrote:
Hi Howard,

Am Sun, 17 Apr 2016 04:05:10 -0700 (PDT) schrieb L. Howard:

I may not understand the duplicates situation you mention.

if you check the output you will find out that it is not correct. The
duplicates are not correctly handled.
It is easier to do it with a formula.
Try:

Sub Find_List_cRows()

Dim aRows As Long, cRows As Long
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
With .Range("B1:B" & aRows)
.Formula = "=IF(COUNTIF(C1:$C" & cRows &
",A1)0,A1,""missing"")"
.Value = .Value
End With
End With
Next 'wsh
Application.ScreenUpdating = True

End Sub


Regards
Claus B.

Hi Claus,

Yes, you are correct. I changed the data to something easier to read and it is incorrect as you say.

I'll give the formula version a try.

Howard

Convert a Find/Loop to an Array macro
 

Hi Howard,

Am Sun, 17 Apr 2016 13:19:21 +0200 schrieb Claus Busch:

Sub Find_List_cRows()

the formula in the posted code does'nt work also.
Try it this way:

Sub Find_List_cRows()

Dim aRows As Long, cRows As Long
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
.Range("B1").Formula = "=IF(COUNTIF(C1:$C" & cRows & ",A1)0,A1,""missing"")"
.Range("B2:B" & aRows).Formula = _
"=IF(AND(COUNTIF($C$1:$C$" & cRows & ",A2)0,COUNTIF($B$1:B1,A2)<COUNTIF($C$1:$C$" _
& cRows & ",A2)),A2,""missing"")"
.Range("B1:B" & aRows).Value = .Range("B1:B" & aRows).Value
End With
Next 'wsh
Application.ScreenUpdating = True

End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Convert a Find/Loop to an Array macro
 

On Sunday, April 17, 2016 at 4:42:35 AM UTC-7, Claus Busch wrote:
Hi Howard,

Am Sun, 17 Apr 2016 13:19:21 +0200 schrieb Claus Busch:

Sub Find_List_cRows()

the formula in the posted code does'nt work also.
Try it this way:

Sub Find_List_cRows()

Dim aRows As Long, cRows As Long
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
.Range("B1").Formula = "=IF(COUNTIF(C1:$C" & cRows & ",A1)0,A1,""missing"")"
.Range("B2:B" & aRows).Formula = _
"=IF(AND(COUNTIF($C$1:$C$" & cRows & ",A2)0,COUNTIF($B$1:B1,A2)<COUNTIF($C$1:$C$" _
& cRows & ",A2)),A2,""missing"")"
.Range("B1:B" & aRows).Value = .Range("B1:B" & aRows).Value
End With
Next 'wsh
Application.ScreenUpdating = True

End Sub


Regards
Claus B.
--


Hi Claus,

BINGO! That works as far as I can determine. I gave it about five different data sets and could not fool it.

Many thanks.

Howard