Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default 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
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default 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
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 852
Default 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
  #5   Report Post  
Posted to microsoft.public.excel.programming
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


  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default 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
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 852
Default 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

  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3,872
Default 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
  #9   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 852
Default 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
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Find/Replace Macro; Need Loop ryguy7272 Excel Programming 7 July 7th 09 04:55 PM
Convert repetitive IF statements to array loop? bntringa[_4_] Excel Programming 5 January 27th 06 10:45 PM
convert excel data to 2-D array using macro David Excel Programming 4 November 13th 05 03:01 PM
Macro Loop, Find, and Total Lou Excel Programming 2 April 28th 04 04:33 PM
variant array containing cel adresses convert to actual ranges-array Peter[_21_] Excel Programming 5 December 10th 03 10:50 PM


All times are GMT +1. The time now is 07:38 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"