Copy based on match criteria. Code Alternative to looping?

DocAElstein · Sep 13, 2014

Copy based on match criteria. Code Alternative to looping?

Hi, I need help in speeding up one of my simple Sort Codes…
.. I have had some success learning in sorting programs from participating in MrExcel Threads, but as a beginner I think my methods are still somewhat primitive (Mostly simple looping). One problem I find in my own project is that my looping method can take very long for some big files of mine.
. I have organized a much shortened version of one of my projects here with working codes of the type which take very long in my actual Files. These files are stripped down to the very minimum for clarity, so of course, are very fast.
. I would appreciate any code alternatives, mainly in the following directions:
. - I have ideas in the direction of filters , Advannced Filter Copy etc. (direct in VBA code or using the evaluate function within VBA to use some sort of spreadsheet filter function), but have no experience at all in this area and am attempting to learn that now. (Column B is free and available and could be used as a help column). Even if there are no speed alternatives I would also appreciate code alternatives to help me in learning different methods.

. So the example A

. This the first sheet in a Main Workbook, before the running of the macros:

Book1

A

B

C

1

Produnt

2

Name

3

Chocolate-europe aroma

4

Chocolate-Cookies

5

Banana-Chocolate-Split

6

Limette-Ksekuchen

7

Erdbeere-Quark

8

Erdbeere-Mix

9

Jamaica Sun

10

Waldbeeren

11

12

13

Tabelle1

. This is the first sheet of another file with entries to be included in the main file by the macros:

Book1

A

B

C

1

Product

2

Name

3

Haselnu-Walnu-aromatisiert

4

Tiramisu

2

5

Chocolate-colonial blend

6

Chocolate-europe aroma

4

7

Chocolate-Cookies

8

Jamaica Sun

6

9

Himbeere-Joghurt

10

Erdbeere-Quark

8

11

Erdbeere-Mix

12

Banana-Chocolate-Split

10

13

Waldbeeren

14

Kirsche

12

15

Kirsche-grner Apfel

16

Kirsche-Ananas

14

17

Stracciatella

18

Limette-Ksekuchen

16

19

grner Apfel-Quark

20

Blutorange-Quark

21

Pro

. This is how the first sheet in the main workbook looks after running the macros:

Book1

A

B

C

1

Produnt

2

Name

3

Chocolate-europe aroma

4

Chocolate-Cookies

5

Banana-Chocolate-Split

10

6

Limette-Ksekuchen

16

7

Erdbeere-Quark

8

Erdbeere-Mix

9

Jamaica Sun

6

10

Waldbeeren

11

12

Tabelle1

Here are the 2 files:
The main File with macros in it (In Module named “SortingMacros”);
XL 2007
FileSnack | Easy file sharing

XL2003
FileSnack | Easy file sharing

The file for entries to be included in the main File;
XL 2007
FileSnack | Easy file sharing

XL 2003
FileSnack | Easy file sharing

. Here are the codes again (XL 2007 versions) first simplified; . and a fuller version with some comments etc.

Code 1

Code:

Sub ProZuBlancoEingabe2Simplified()
Application.ScreenUpdating = False
Dim Blanco As String, Pro As String
Let Blanco = "MrExcelMainFileSorting2_2007.xlsm"
Let Pro = "MrExcelFileWithEntries2_2007.xlsx"
Dim wkstBlc As Worksheet, wkstPro As Worksheet
Set wkstBlc = Workbooks(Blanco).Worksheets.Item(1)
Set wkstPro = Workbooks(Pro).Worksheets.Item(1)
Dim CClmPPRow As Long, CClmBlcoRow As Long

  For CClmBlcoRow = 3 To 10 Step 1
    For CClmPPRow = 3 To 20 Step 1
    Application.StatusBar = "Blanco Row " & CClmBlcoRow & " Pro Row " & CClmPPRow
      If wkstBlc.Cells(CClmBlcoRow, 1).Value = wkstPro.Cells(CClmPPRow, 1).Value And wkstPro.Cells(CClmPPRow, 3).Value <> "" Then
      Let wkstBlc.Cells(CClmBlcoRow, 3).Value = wkstPro.Cells(CClmPPRow, 3).Value
      Else
      End If
    Next CClmPPRow
  Next CClmBlcoRow
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

Sub ProZuBlancoEingabe2() 'Look for Name match and Entry in every row ' Application.ScreenUpdating = False Dim Blanco As String, Pro As String 'File names Let Blanco = "MrExcelMainFileSorting2_2007.xlsm" 'Test Main File for MrExcel Let Pro = "MrExcelFileWithEntries2_2007.xlsx" 'Test File with Entries for MrExcel Dim wkstBlc As Worksheet, wkstPro As Worksheet 'Main File Worksheet, File with Entries Worksheet Set wkstBlc = Workbooks(Blanco).Worksheets.Item(1) 'First sheet in Main File Set wkstPro = Workbooks(Pro).Worksheets.Item(1) 'First sheet in File with entries Dim CClmPPRow As Long, CClmBlcoRow As Long 'C Columns in Spreadsheets Row Count 'Main Program 'Strategy: Take each Row in turn in Blanco then look through each row in Pro for a name match in first column and an Entry in Pro column C. Then if a an entry is given in Pro Column C, copy that value to Blanco Column C For CClmBlcoRow = 3 To 10 Step 1 'For each row in Blanco.... For CClmPPRow = 3 To 20 Step 1 '....Go through rows in Pro Application.StatusBar = "Blanco Row " & CClmBlcoRow & " Pro Row " & CClmPPRow 'Can be ommited for speed but in large files is not usually the limiting factor If wkstBlc.Cells(CClmBlcoRow, 1).Value = wkstPro.Cells(CClmPPRow, 1).Value And wkstPro.Cells(CClmPPRow, 3).Value <> "" Then 'Check for name match and an Entry In Pro Column C Let wkstBlc.Cells(CClmBlcoRow, 3).Value = wkstPro.Cells(CClmPPRow, 3).Value 'Match and Entry found so write entry value from Entry File in Main File Else 'Else no match and entry so do nothhing! End If Next CClmPPRow 'Go to next Pro Row.. Next CClmBlcoRow '... when Pro row to end start again witn next row in Blanco Application.ScreenUpdating = True Application.StatusBar = False End Sub 'ProZuBlancoEingabe2()

Code 2

Code:

Sub ProZuBlancoEingabe3Simplified()
Application.ScreenUpdating = False
Dim Blanco As String, Pro As String
Let Blanco = "MrExcelMainFileSorting2_2007.xlsm"
Let Pro = "MrExcelFileWithEntries2_2007.xlsx"
Dim wkstBlc As Worksheet, wkstPro As Worksheet
Set wkstBlc = Workbooks(Blanco).Worksheets.Item(1)
Set wkstPro = Workbooks(Pro).Worksheets.Item(1)
Dim CClmPPRow As Long, CClmBlcoRow As Long
Dim Match As Boolean

  For CClmPPRow = 3 To 20 Step 1
    If wkstPro.Cells(CClmPPRow, 3).Value <> "" Then
      Match = True
      For CClmBlcoRow = 3 To 10 Step 1
      Application.StatusBar = "Blanco Row " & CClmBlcoRow & " Pro Row " & CClmPPRow
        If wkstBlc.Cells(CClmBlcoRow, 1).Value = wkstPro.Cells(CClmPPRow, 1).Value Then
        Let wkstBlc.Cells(CClmBlcoRow, 3).Value = wkstPro.Cells(CClmPPRow, 3).Value
        Let Match = False
        Else
        End If
      Next CClmBlcoRow
      If Match = True Then
      MsgBox "Entry in Pro for " & wkstPro.Cells(CClmPPRow, 1).Value & ".  But no match in Blanco"
      Let Match = False
      Else
      End If
    Else
    End If
  Next CClmPPRow
  
TheEnd:
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

Sub ProZuBlancoEingabe3() 'look first only for C Column entry and then a match in Names ' Application.ScreenUpdating = False Dim Blanco As String, Pro As String 'File names Let Blanco = "MrExcelMainFileSorting2_2007.xlsm" 'Test Main File for MrExcel Let Pro = "MrExcelFileWithEntries2_2007.xlsx" 'Test File with Entries for MrExcel Dim wkstBlc As Worksheet, wkstPro As Worksheet 'Main File Worksheet, File with entries Worksheet Set wkstBlc = Workbooks(Blanco).Worksheets.Item(1) 'First sheet in main File Set wkstPro = Workbooks(Pro).Worksheets.Item(1) 'First sheet in File with entries Dim CClmPPRow As Long, CClmBlcoRow As Long 'C Columns in Spreadsheets Row Count Dim Match As Boolean 'Flag (Indicator) for match found = True for match or = False for no match found 'Main Program 'Strategy: look down C Column rows in Pro and when an entry is there loop through name columns in Blanco to find match in Names For CClmPPRow = 3 To 20 Step 1 'look down C Column rows... If wkstPro.Cells(CClmPPRow, 3).Value <> "" Then '....Look for entry in pro Column, If found.... Match = True 'Match Found For CClmBlcoRow = 3 To 10 Step 1 'For each Blanco C cell (or rather down the rows in Blanco) Application.StatusBar = "Blanco Row " & CClmBlcoRow & " Pro Row " & CClmPPRow 'Can be ommited for speed but in large files is not usually the limiting factor If wkstBlc.Cells(CClmBlcoRow, 1).Value = wkstPro.Cells(CClmPPRow, 1).Value Then 'Check for Name match Let wkstBlc.Cells(CClmBlcoRow, 3).Value = wkstPro.Cells(CClmPPRow, 3).Value 'Match found so type in amount in Blanco Let Match = False 'reset Match indicater for next loop Else 'No Name match so do nothing End If Next CClmBlcoRow 'look again for a match in next Blanco C Row. If Match = True Then 'We have not reset Match to false so we had an entry but no match MsgBox "Entry in Pro for " & wkstPro.Cells(CClmPPRow, 1).Value & ". But no match in Blanco" Let Match = False 'The user is warned of entry but no match. So reset Match = False for next loop Else 'Match is reset to false so match was found so do nothing (No warning MsgBox of no match) End If Else 'Else do nothhing as no entry was found in Column c of Pro. End If Next CClmPPRow ' go to next Row in C column of Pro and look for entry ' TheEnd: Application.ScreenUpdating = True Application.StatusBar = False End Sub 'ProZuBlancoEingabe3()

Thanks,
Alan.

DocAElstein · Sep 29, 2014

JUST ANOTHER TRY IN GOOGLE CHROME BROWSER::: WORKS BETTER FOR Me TODAY!?!

Jerry Sullivan said:
…….. try using the MicroTimer code that Charles Williams shows in this article....

Excel 2010 Performance: Improving Calculation Performance

Just to clarify, looping through data stored in memory can be a very fast approach. Your Test_5 (dictionary approach) uses loops and is fast. The thing to avoid is solutions with loops that have a large number of iterations and a relatively high amount of overhead time associated with each iteration (like reading and writing to worksheets).

Hi Jerry.
.. Thanks for that. I caught that link from your other threads. Got a bit bogged down at first glance but now I see the bit about Charles Williams Codes stuff I shall take another look with a mind to testing out my SIX codes…***

Jerry Sullivan said:
…. Well done on your continued learning. Thank you for sharing your findings.
………..

. My biggest frustration is having to take long breaks when I am keen to learn and so I “lose the Thread” as it were (I do not mean literally – I have them all saved and all codes backed up etc.) and miss the point then sometimes. The help from you and other regulars (both in the threads I am in and previous ones that I try hard to find in the massive wealth of info here) is proving invaluable just now……*** - I have now finally a one line Evaluate Range VLOOKUP code from RoryA. It was a great surprise (But I think I may go a bit trying to pull it apart with green code comments until I understand it!!!). I hope get so far as to come up with something like that one day!!
. And thanks to the codes you and others adapted for my examples I was able to convert the code from RoryA quite quickly to get it in the right syntax for my specific examples….

. Here is the 6^th code

Code:

[color=darkblue]Sub[/color] RoryA_6JerryS_Evaluate()
 
Application.ScreenUpdating = [color=darkblue]False[/color]
[color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] TheEnd
[color=darkblue]Dim[/color] wkstBlc [color=darkblue]As[/color] Worksheet, wkstPro [color=darkblue]As[/color] Worksheet [color=green]'Main File Worksheet, File with entries Worksheet[/color]
[color=darkblue]Dim[/color] Blanco [color=darkblue]As[/color] [color=darkblue]String[/color], FullProName [color=darkblue]As[/color] [color=darkblue]String[/color]
[color=darkblue]Let[/color] Blanco = "xx.09.2014.xlsm"
[color=darkblue]Set[/color] wkstBlc = Workbooks(Blanco).Worksheets.Item(1) [color=green]'First sheet in main File[/color]
[color=darkblue]Let[/color] FullProName = "26.09.2014.ods"
[color=darkblue]Set[/color] wkstPro = Workbooks(FullProName).Worksheets.Item(1) [color=green]'First sheet in File with entries[/color]
[color=darkblue]Dim[/color] rngName [color=darkblue]As[/color] Range
[color=darkblue]Set[/color] rngName = wkstBlc.Range("A3:A638")
  [color=darkblue]Dim[/color] lLastRow [color=darkblue]As[/color] [color=darkblue]Long[/color] [color=green]'[/color]
  lLastRow = 638
  [color=darkblue]Dim[/color] rngCC [color=darkblue]As[/color] Range
  [color=darkblue]Set[/color] rngCC = wkstBlc.Range("C3:C" & lLastRow)
  [color=darkblue]Let[/color] rngCC.Value = Evaluate("transpose(INDEX(VLOOKUP(T(IF(1,TRANSPOSE(" & rngName.Address & ")))," & wkstPro.Range("A3:C638").Address(External:=True) & ",3,FALSE),))")
TheEnd:
Application.ScreenUpdating = [color=darkblue]True[/color]
Application.StatusBar = [color=darkblue]False[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color] [color=green]'RoryA6JerryS_Evaluate()[/color]

And the updated XL2007 File
Main File with Macros (Effectively the Look up values)
https://app.box.com/s/he5vb6xp2vmwzwck2lbd

And here is a spreadsheet version I have worked out (Arbitrarily for lookup Value in cell A564 (Birne: (Pear in English!)):
In German:
=MTRANS(INDEX(SVERWEIS(T(WENN(1;MTRANS(A564)));[26.09.2014.ods]Tabelle1!$A$3:$D$638;3;0)

)
And English:
=TRANSPOSE(INDEX(VLOOKUP(T(IF(1,TRANSPOSE(A564))),[26.09.2014.ods]Tabelle1!$A$3:$D$638,3,0),))

. I hope I can get my head around them sometime to understand them!!.

. In the meantime I will try to find time to get those Speed codes up and running for my codes. And I will report back my results.

Many thanks again.
Alan

DocAElstein · Oct 4, 2014

. Hi
. I have the speed test codes up and running and applied to my 6 or VBA codes.
. As often with Microsoft stuff, I found the link article Excel 2010 Performance: Improving Calculation Performance not too clear. It does have a lot of good general information on Spreadsheet calculation times etc, but the Charles Williams MicroTimer code is not too clearly shown or explained. The code in question presented there is a Function() Subroutine in one of the code Windows there. The Function MicroTimer() Code is tucked under some initial Private declaration stuff. This private declaration stuff is different in some other references to the Charles Williams MicroTimer code !?.
. So I “went back” and learnt about the normal VBA Timer() Function.
. I wrote a simple Function() subroutine that uses that Function.
. Then I wrote or rather played around with the published Charles Williams MicroTimer codes, and included the Private declaration stuff which appeared to be necessary, until I had a similar looking Function() Subroutine for the Charles Williasms MicroTimer
. Then I wrote a short Subroutine which calls the codes of mine I wish to speed test and then it uses (calls) the two timer functions on these codes a few times then gives the average results out in a message box.
.
. It looks something like this (Arbitrarily with my second Code_2 selected for testing)

Code:

[color=darkblue]Option[/color] [color=darkblue]Explicit[/color]
[color=green]' next 2 lines needed for 'Charley Williams Micro Timer Code[/color]
[color=darkblue]Private[/color] [color=darkblue]Declare[/color] [color=darkblue]Function[/color] getFrequency [color=darkblue]Lib[/color] "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency [color=darkblue]As[/color] [color=darkblue]Currency[/color]) [color=darkblue]As[/color] [color=darkblue]Long[/color]
[color=darkblue]Private[/color] [color=darkblue]Declare[/color] [color=darkblue]Function[/color] getTickCount [color=darkblue]Lib[/color] "kernel32" Alias "QueryPerformanceCounter" (cyTickCount [color=darkblue]As[/color] [color=darkblue]Currency[/color]) [color=darkblue]As[/color] [color=darkblue]Long[/color]
[color=green]'[/color]
[color=darkblue]Sub[/color] Timers() 'SubRoutine to call Timer Functions and Subroutines under test and display results.
 
    [color=darkblue]Dim[/color] StartMTTime [color=darkblue]As[/color] [color=darkblue]Single[/color], StartVBATime [color=darkblue]As[/color] [color=darkblue]Single[/color] [color=green]'times inn seconds at start of a run[/color]
    [color=darkblue]Dim[/color] MTTime [color=darkblue]As[/color] [color=darkblue]Single[/color], VBATime [color=darkblue]As[/color] [color=darkblue]Single[/color] [color=green]'Run times given from Timer Functions[/color]
    [color=darkblue]Let[/color] MTTime = 0 [color=green]'Could leave this out, but good[/color]
    [color=darkblue]Let[/color] VBATime = 0 [color=green]'Practice to put it in[/color]
    [color=darkblue]Dim[/color] Iteration [color=darkblue]As[/color] [color=darkblue]Long[/color], MaxIteration [color=darkblue]As[/color] [color=darkblue]Long[/color] [color=green]'Variable used in avaraging a few runs[/color]
    [color=darkblue]Let[/color] MaxIteration = 100 [color=green]'Set here the nimber of runs that you want.[/color]
 [color=green]'   ProZuBlancoEingabeAlan_1 'A run without[/color]
    ProZuBlancoEingabeAlan_2 [color=green]'timing is often[/color]
  [color=green]'  ProZuBlancoEingabepgcJerry_3VLOOKUPFormulaWith 'said to be[/color]
 [color=green]'   ProZuBlancoEingabepgcJerry_4VLOOKUPFormulaLoop 'a good idea. [color=darkblue]For[/color] example[/color]
[color=green]'    ProZuBlancoEingabe_3cVBA_pgc 'because soometimes extra things[/color]
[color=green]'    Test_5JerryScriptedRuntimeDictionary 'may be done the first[/color]
[color=green]'    DominicRoryA_6bJerryS_Evaluate[/color]
      For Iteration = 1 [color=darkblue]To[/color] MaxIteration [color=green]'Run as many times as specified.[/color]
     
      [color=darkblue]Let[/color] StartMTTime = MicroTimer [color=green]'Function Code from Charley Williams[/color]
      [color=darkblue]Let[/color] StartVBATime = VBATimer [color=green]'Typical VBA Timer() Function code[/color]
 [color=green]'     ProZuBlancoEingabeAlan_1[/color]
      ProZuBlancoEingabeAlan_2
 [color=green]'     ProZuBlancoEingabepgcJerry_3VLOOKUPFormulaWith[/color]
 [color=green]'     ProZuBlancoEingabepgcJerry_4VLOOKUPFormulaLoop[/color]
  [color=green]'    ProZuBlancoEingabe_3cVBA_pgc[/color]
[color=green]'      Test_5JerryScriptedRuntimeDictionary[/color]
[color=green]'      DominicRoryA_6bJerryS_Evaluate[/color]
      [color=darkblue]Let[/color] MTTime = (MTTime + (MicroTimer - StartMTTime)) [color=green]'Total times so[/color]
      [color=darkblue]Let[/color] VBATime = (VBATime + (VBATimer - StartVBATime)) [color=green]'far.[/color]
      [color=darkblue]Next[/color] Iteration 'Go and do another run(s)
    MsgBox "Micro Timer " & (MTTime) / MaxIteration & " Seconds" & vbCr & _
           "VBA Timer " & (VBATime) / MaxIteration & " Seconds" [color=green]'Display avarage results.[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color] [color=green]' Timers()[/color]
[color=darkblue]Function[/color] VBATimer()
[color=green]'Typical VBA Timer Progra[/color]
    VBATimer = Timer [color=green]'Timer is a VBA Function that gives current time in seconds[/color]
[color=darkblue]End[/color] [color=darkblue]Function[/color] [color=green]' VBATimer()[/color]
[color=darkblue]Function[/color] MicroTimer() [color=darkblue]As[/color] [color=darkblue]Single[/color] 'Charley Williams Micro Timer Code
 
    [color=darkblue]Dim[/color] cyTicks1 [color=darkblue]As[/color] [color=darkblue]Currency[/color]
    [color=darkblue]Static[/color] cyFrequency [color=darkblue]As[/color] [color=darkblue]Currency[/color]
    [color=darkblue]Let[/color] MicroTimer = 0
      [color=darkblue]If[/color] cyFrequency = 0 [color=darkblue]Then[/color] getFrequency cyFrequency [color=green]' get ticks/sec[/color]
      getTickCount cyTicks1 [color=green]' get ticks[/color]
      [color=darkblue]If[/color] cyFrequency [color=darkblue]Then[/color] MicroTimer = cyTicks1 / cyFrequency ' calc seconds
    
[color=darkblue]End[/color] [color=darkblue]Function[/color] [color=green]'MicroTimer()[/color]
'

. The results below are only provisional as I have noticed that each time I do the test there can be large variations. So as time goes on I will repeat the experiments in various different situations to get a better spread for averaging. Also I will check through the codes as there may be improvements in one code not applicable to the others which may change it’s “relative rating” as it were!. I may also be hitting on a fundamental limit not directly related to the particular Code method

Test #	Method Description	Approx Processing time in seconds
Test*_1	Full Simple (Double) Looping	800
Test_2	Improved Simple looping	7
Tests_3	enters Vlookup formula into results range (with Range)	.3
Test_3c	VBA App.Vlookup	.31
Test_4	enters Vlookup formula into results range (with loop)	3.5
Test_5	Scripting Dictionary	.3
Test_6	Range Evaluate statement with Vlookup function	.4
Test_7	Range Evaluate statement with INDEX function	My next ’Crazy’ idea!

Alan

P.S. Updated Files Again:-
Main File with Macros(Effectively the Look up values) (XL 2007 .xlsm)
https://app.box.com/s/tznm5lwwy5axf6d3n9nq

File with Entries(Effectively the Look Up Table) ( .ods – opens normal in Excel)
https://app.box.com/s/4yc7w1e1fpdcab3vkbl7

DocAElstein · Oct 5, 2014

DocAElstein said:
. Hi
. I have the speed test codes up and running and applied to my 6 or so VBA codes.
. As often with Microso........
. .
.............................................
. The results below are only provisional as I have noticed that each time I do the test there can be large variations. So as time goes on I will repeat the experiments in various different situations to get a better spread for averaging. Also I will check through the codes as there may be improvements in one code not applicable to the others which may change it’s “relative rating” as it were!. I may also be hitting on a fundamental limit not directly related to the particular Code method...
.....
...................

. Just occurred to me that I neglected to mention that the normal VBA Timer() Function and the Charles Williams MicroTimer Function() Code gave me almost identical results. It maybe then as in my last comments that I have some Fundamental limit not directly related to the different methods. Still it is good to have it up and running in parallel if as I further develop the extra accuracy is needed.
. (Meanwhile I concentrate on understanding that one line “Range Evaluate VLOOKUP wonder” from RoryA used in the code for Test_6 and try then to do a similar one Liner for the INDEX MATCH alternative to VLOOKUP to complete a good full method selection?… that will either help stop the grea matter going to mush… or..

)

DocAElstein · Oct 10, 2014

Hi, <o

></o

>
. Just to tidy up the failing measurements herefor the last Method. A couple of formulas were given by RoryA for the Evaluatestatement with INDEX with MATCH as alternative to the Evaluate statement withVLOOKUP (This should have overcome the limitation of the 255 characters withVLOOKUP) .<o

></o

>
. one is based on my more fundamental versionsof Domenic’s code and the second is something weird “convoluted” from RoryA (Domenic’s code we have not been able to“co-coerce” to work in the Evaluate Range thing) <o

></o

>
. I have adapted the two in codes 7a and 7b given below. Also I havetyped in a Spreadsheet versions: Formulafor 7a is in cell B6, For formula 7b I had to do an array enter thing to get itto work. Not quite sue wot that is but I followed the following instructionsfor that….

RoryA said:
Selectcells, press f2, paste the formula in, ……...

<o

></o

>
Then enter withCtrl+Shift+Enter.If entered correctly, Excel willsurround with curly braces {}.
Note1 : Do not try and enter the {} manuallyyourself<o

></o

>
Note 2 : You must notselect all cells but results you get will start from the first lookup row……<o

></o

>
<o

></o

>
Because of note 2 I put this formula in the first 3 rows (cells B3 to B5).This table I produce in the next Reply / Post #15<o

></o

>
<o

> </o

>
<o

> </o

>
. The first formula strangely did notovercome the 255 character Limit. The Second did. But It introduced a newproblem with errors with duplicate entries in big Look Up tables. So I will belooking further at this…..<o

></o

>
. And in addition in the future hopefully dosome tests with even bigger files to get better speed comparison results. Mysecond simple looping program may give the best simple, flexible and,importantly, maintainable and understandable solution if the extra time can betolerated. With the exception of the RuntimeScripting Test_5 (dictionary approach) all other solutions can give problemswith more complicated files with Null entries and duplicate entries etc. Also theRuntime Scripting Test_5 (dictionary approach) would appear to be the fastest despitethat it is indeed involved with looping. I still like the idea of improving andperfecting the idea of the Range Evaluate idea applied to a Function such asthe last INDEX with MATCH solution, 7b. My greatest problem with that ishowever in understanding to a level to be able to consistently coerce it towork as well as have generally an in depth understanding to overcome forexample the latest problem it threw out with my files, that of inconsistently beingintolerant (strangely only with larger files) of duplicate Look Up values inthe Look Up table.<o

></o

>
. However I am beginning to think that nobodycan understand formulas like our last ones.. ..<o

></o

>
. <o

></o

>
<o

> </o

>
rngCC.Value = Evaluate("INDEX(INDEX("& wkstPro.Range("A3:C638").Address(External:=True) &",N(IF(1,MMULT(N(TRANSPOSE(" &wkstPro.Range("A3:A638").Address(External:=True) & ")="& rngName.Address & "),ROW(" &wkstPro.Range("A3:A638").Address(External:=True) &")-ROW(" & wkstPro.Range("A2").Address(External:=True)& ")))),3),)")<o

></o

>
<o

> </o

>
=INDEX(INDEX($C$16:$C$33,N(IF(1,MMULT(N(TRANSPOSE($A$16:$A$33)=$A$3:$A$10),ROW($A$16:$A$33)-ROW($A$15))))),)<o

></o

>
. - And it may be an art based on experience(which I do not have !!) to even get them at all in any way to work. This makesit of-course somewhat dangerous to use.. But it is one hell of a learning andbrain stretching exercise for a Beginner like me!!<o

></o

>
<o

> </o

>
Codes 7a and 7b:<o

></o

>
<o

> </o

>

Code:

[color=darkblue]Sub[/color] DominicAlanRoryA_7aJerryS_EvaluateINDEXwithMATCH() [color=green]'Evaluate one liner using INDEX with MATCH als alternative to VLOOKUP to get over 255 Character Limit[/color]
[color=green]'[/color]

<o

></o

>
<o

></o

>
TheEnd:<o

></o

>
Application.ScreenUpdating= True<o

></o

>
Application.StatusBar= False<o

></o

>
EndSub 'RoryA_7bJerryS_EvaluateINDEXwithMATCH()[/CODE]<o

></o

>
<o

> </o

>
<o

> </o

>
Some more results<o

></o

>
<o

> </o

>
<o

> </o

>
<o

> </o

>

Test #<o></o>	Method Description<o></o>	Approx Processing time in seconds <o></o>
Test_1<o></o>	Full Simple (Double) Looping<o></o>
Test_2<o></o>	Improved Simple looping<o></o>	5.1<o></o>
Tests_3<o></o>	enters Vlookup formula into results range (with Range)<o></o>	.31<o></o>
Test_3c<o></o>	VBA App.Vlookup<o></o>	.36<o></o>
Test_4 <o></o>	enters Vlookup formula into results range (with loop)<o></o>	2.47<o></o>
Test_5<o></o>	Scripting Dictionary<o></o>	<o> </o> .29<o></o>
Test_6<o></o>	Range Evaluate statement Vlookup function<o></o>	.45<o></o>
Test_7a<o></o> ______<o></o> Test_7b<o></o>	Range Evaluate statement INDEX with MATCH function<o></o>	.4<o></o> _______<o></o> .79<o></o>

<o

> </o

>
Alan <o

></o

>
<o

> </o

>
P.S. Updated FilesAgain:-<o

></o

>
Main File with Macros(Effectively the Look up values) (XL 2007 .xlsm)
https://app.box.com/s/tznm5lwwy5axf6d3n9nq<o

></o

>
<o

> </o

>

File with Entries(Effectively the Look Up Table) ( .ods – opens normal in Excel)
https://app.box.com/s/4yc7w1e1fpdcab3vkbl7<o

></o

>

DocAElstein · Oct 10, 2014

Table (and Codes again!!)

Book1

A

B

C

1

2

3

*** SOYAsojasource 77/,1/12/6,9/3,7/,6/8,3/ soysoacjap 39/0/3,5/6/ / / /spanish vineger 26/0/,023/,53//// balsamico 87/0/1/16/13/0/,05/

0

4

ErroskiWine

0.1

5

SENF english 170/6,7/6/21//// grill & steak 118/6,3/5,8/8,1//// sweetpickle130/,2/,8/31////

0

6

BRN SAUCE piccalilli 67/,5/1,4/14//// light 54/,1/1/11,5/11,3/,9/1/ ketundmayo 353/33/1/13/5/0/,1/

0.2

Tabelle1

Cell Formulas
Range	Formula
B6	=INDEX(INDEX([26.09.2014.ods]Tabelle1!$A$3:$C$638,N(IF(1,MATCH($A6,[26.09.2014.ods]Tabelle1!$A$3:$A$638,0))),3),)
B3:B5	{=INDEX(INDEX([26.09.2014.ods]Tabelle1!$A$3:$C$638,N(IF(1,MMULT(N(TRANSPOSE([26.09.2014.ods]Tabelle1!$A$3:$A$638)=$A$3:$A$638),ROW([26.09.2014.ods]Tabelle1!$A$3:$A$638)-ROW([26.09.2014.ods]Tabelle1!$A$3:$A$638)))),3),)}
Press CTRL+SHIFT+ENTER to enter array formulas.

Corresonding Look Up Table

Book1

A

B

C

3

*** SOYAsojasource 77/,1/12/6,9/3,7/,6/8,3/ soysoacjap 39/0/3,5/6/ / / /spanish vineger 26/0/,023/,53//// balsamico 87/0/1/16/13/0/,05/

4

ErroskiWine

0.1

5

SENF english 170/6,7/6/21//// grill & steak 118/6,3/5,8/8,1//// sweetpickle130/,2/,8/31////

6

BRN SAUCE piccalilli 67/,5/1,4/14//// light 54/,1/1/11,5/11,3/,9/1/ ketundmayo 353/33/1/13/5/0/,1/

0.2

7

ERDBEER-FRUCTAUFSTRICH pickle 130/,2/,6/31/30/,5/,2/chutney 130/,2/,8/31//// wellness 97/,15/,4/34,3/7/1,4/,03/ketchup 106/,1/1/25,5/25(barb 19,4)/,9/,8/ ketundmayo 353/33/1/13/5/0/,1/

8

HEFEKUCHEN creme 266/6,4/6,2/47,4/9,2/1,57,3/ hefeschneckcremechinois 287/6,4/6,1/51,2/13,5/1,8/,2/ minichinois&rosinen 270/7,8/6,2/43,7/17,2/,9/,4/ schneckvanros 341/10,6/4,8/56,6/27/2,5/,21/

Tabelle1

Code:

[color=green]'[/color]
[color=darkblue]Sub[/color] DominicAlanRoryA_7aJerryS_EvaluateINDEXwithMATCH() 'Evaluate one liner using INDEX with MATCH als alternative to VLOOKUP to get over 255 Character Limit
[color=green]'[/color]
 
' My more fundamental version of Dominics INDEX with MATCH Formula
Application.ScreenUpdating = [color=darkblue]False[/color]
[color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] TheEnd
[color=darkblue]Dim[/color] wkstBlc [color=darkblue]As[/color] Worksheet, wkstPro [color=darkblue]As[/color] Worksheet [color=green]'Main File Worksheet, File with entries Worksheet[/color]
[color=darkblue]Dim[/color] Blanco [color=darkblue]As[/color] [color=darkblue]String[/color], FullProName [color=darkblue]As[/color] [color=darkblue]String[/color]
[color=darkblue]Let[/color] Blanco = "xx.09.2014.xlsm"
[color=darkblue]Set[/color] wkstBlc = Workbooks(Blanco).Worksheets.Item(1) [color=green]'First sheet in main File[/color]
[color=darkblue]Let[/color] FullProName = "26.09.2014.ods"
[color=darkblue]Set[/color] wkstPro = Workbooks(FullProName).Worksheets.Item(1) [color=green]'First sheet in File with entries[/color]
[color=darkblue]Dim[/color] rngName [color=darkblue]As[/color] Range
[color=darkblue]Set[/color] rngName = wkstBlc.Range("A3:A638")
  [color=darkblue]Dim[/color] lLastRow [color=darkblue]As[/color] [color=darkblue]Long[/color] [color=green]'[/color]
  lLastRow = 638
  [color=darkblue]Dim[/color] rngCC [color=darkblue]As[/color] Range
  [color=darkblue]Set[/color] rngCC = wkstBlc.Range("C3:C" & lLastRow)
  [color=green]'  Formula Alan[/color]
  [color=darkblue]Let[/color] rngCC.Value = Evaluate("INDEX(INDEX(" & wkstPro.Range("A3:C638").Address(External:=True) & ",N(IF(1,MATCH($A$3:$A$628," & wkstPro.Range("A3:A638").Address(External:=True) & ",0))),3),)")
  [color=green]'                =INDEX(INDEX([26.09.2014.ods]Tabelle1!$A$3:$C$638;N(WENN(1;VERGLEICH($A6;[26.09.2014.ods]Tabelle1!$A$3:$A$638;0)));3);)[/color]
  [color=green]'                =INDEX(INDEX([26.09.2014.ods]Tabelle1!$A$3:$C$638,N(IF(1,MATCH($A6,[26.09.2014.ods]Tabelle1!$A$3:$A$638,0))),3),)[/color]
TheEnd:
Application.ScreenUpdating = [color=darkblue]True[/color]
Application.StatusBar = [color=darkblue]False[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color] [color=green]'DominicAlanRoryA_7aJerryS_EvaluateINDEXwithMATCH()[/color]
 
[color=darkblue]Sub[/color] RoryA_7bJerryS_EvaluateINDEXwithMATCH() [color=green]'Evaluate one liner using INDEX with MATCH als alternative to VLOOKUP to get over 255 Character Limit[/color]
 
[color=green]'[/color]
 
'   A Mega 2nd Formula from RoryA which nobody unnderstands, (even him I think!!)
Application.ScreenUpdating = [color=darkblue]False[/color]
[color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] TheEnd
[color=darkblue]Dim[/color] wkstBlc [color=darkblue]As[/color] Worksheet, wkstPro [color=darkblue]As[/color] Worksheet [color=green]'Main File Worksheet, File with entries Worksheet[/color]
[color=darkblue]Dim[/color] Blanco [color=darkblue]As[/color] [color=darkblue]String[/color], FullProName [color=darkblue]As[/color] [color=darkblue]String[/color]
[color=darkblue]Let[/color] Blanco = "xx.09.2014.xlsm"
[color=darkblue]Set[/color] wkstBlc = Workbooks(Blanco).Worksheets.Item(1) [color=green]'First sheet in main File[/color]
[color=darkblue]Let[/color] FullProName = "26.09.2014.ods"
[color=darkblue]Set[/color] wkstPro = Workbooks(FullProName).Worksheets.Item(1) [color=green]'First sheet in File with entries[/color]
[color=darkblue]Dim[/color] rngName [color=darkblue]As[/color] Range
[color=darkblue]Set[/color] rngName = wkstBlc.Range("A3:A638")
  [color=darkblue]Dim[/color] lLastRow [color=darkblue]As[/color] [color=darkblue]Long[/color] [color=green]'[/color]
  lLastRow = 638
  [color=darkblue]Dim[/color] rngCC [color=darkblue]As[/color] Range
  [color=darkblue]Set[/color] rngCC = wkstBlc.Range("C3:C" & lLastRow)
  [color=green]'  Formula Alan (Rory) Muss Array formula[/color]
  [color=green]'   and must start in Row 3 to be typed in[/color]
  [color=green]'                         =INDEX(INDEX($C$16:$C$33;N(WENN(1;MMULT(N(MTRANS($A$16:$A$33)=$A$3:$A$10);ZEILE($A$16:$A$33)-ZEILE($A$15)))));)[/color]
  [color=green]'                        =INDEX(INDEX($C$16:$C$33,N(IF(1,MMULT(N(TRANSPOSE($A$16:$A$33)=$A$3:$A$10),ROW($A$16:$A$33)-ROW($A$15))))),)[/color]
  [color=darkblue]Let[/color] rngCC.Value = Evaluate("INDEX(INDEX(" & wkstPro.Range("A3:C638").Address(External:=True) & ",N(IF(1,MMULT(N(TRANSPOSE(" & wkstPro.Range("A3:A638").Address(External:=True) & ")=" & rngName.Address & "),ROW(" & wkstPro.Range("A3:A638").Address(External:=True) & ")-ROW(" & wkstPro.Range("A2").Address(External:=True) & ")))),3),)")
  [color=green]'     =INDEX(INDEX([26.09.2014.ods]Tabelle1!$A$3:$C$638;N(WENN(1;MMULT(N(MTRANS([26.09.2014.ods]Tabelle1!$A$3:$A$638)=$A$3:$A$638);ZEILE([26.09.2014.ods]Tabelle1!$A$3:$A$638)-ZEILE([26.09.2014.ods]Tabelle1!$A$3:$A$638))));3);)[/color]
  [color=green]'     =INDEX(INDEX([26.09.2014.ods]Tabelle1!$A$3:$C$638,N(IF(1,MMULT(N(TRANSPOSE([26.09.2014.ods]Tabelle1!$A$3:$A$638)=$A$3:$A$638),ROW([26.09.2014.ods]Tabelle1!$A$3:$A$638)-ROW([26.09.2014.ods]Tabelle1!$A$3:$A$638)))),3),)[/color]
  [color=green]'[/color]
 
TheEnd:
Application.ScreenUpdating = [color=darkblue]True[/color]
Application.StatusBar = [color=darkblue]False[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color] [color=green]'RoryA_7bJerryS_EvaluateINDEXwithMATCH()[/color]

Copy based on match criteria. Code Alternative to looping?

DocAElstein

Banned user

DocAElstein

Banned user

Excel Facts

DocAElstein

Banned user

DocAElstein

Banned user

DocAElstein

Banned user

DocAElstein

Banned user

Similar threads

Forum statistics

Share this page

Copy based on match criteria. Code Alternative to looping?

DocAElstein

Banned user

DocAElstein

Banned user

Excel Facts

DocAElstein

Banned user

DocAElstein

Banned user

DocAElstein

Banned user

DocAElstein

Banned user

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock