Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Find/Replace Macro; Need Loop | Excel Programming | |||
Convert repetitive IF statements to array loop? | Excel Programming | |||
convert excel data to 2-D array using macro | Excel Programming | |||
Macro Loop, Find, and Total | Excel Programming | |||
variant array containing cel adresses convert to actual ranges-array | Excel Programming |