PDA

View Full Version : Solved: How to change the index of an array



troelsi
03-26-2008, 02:21 AM
Hi Experts!

I have a large amount of product data i.e. productnames, inventory-levels, costs and so forth. I have the data stored in a user-defined array (I can change it to a class). Every time I have to look-up some information about a particular productnumer I cycle through the entire array. It think it's very time-consuming, my code is very slow and I believe that if the above process could be more efficient it would mean a lot to my code. I was wondering Therefore if it would be possible to change the array's index to a string, like in the following example.
First this is how the codes operates now:

Type arrt
Productname As String
productnumber As String
End Type
Sub test()
Dim arr(1 To 3) As arrt
Dim i As Integer
arr(1).Productname = abc
arr(1).productnumber = p2010 - 2
arr(2).Productname = abcd
arr(2).productnumber = 221055
arr(3).Productname = abcde
arr(3).productnumber = scf - 15475
For i = LBound(arr) To UBound(arr)
If arr(i).productnumber = p2010 - 2 Then
MsgBox "perfect"
End If
Next i
End Sub

And this is how I would like to use the index to look up my productnumber. The same data as above is used:


Sub test2()
If arr(p2010 - 2).Productname = abcd Then
MsgBox "perfect"
End If
End Sub


Is that possible and how to do it?
Thanks

Bob Phillips
03-26-2008, 03:37 AM
Try Classes dear Henry, Classes.

Create a class and call it Product with this code



Option Explicit

Private mmName As String
Private mmNumber As String

Public Property Let Name(ByVal Name As String)
mmName = Name
End Property
Public Property Get Name() As String
Name = mmName
End Property

Public Property Let Number(ByVal Number As String)
mmNumber = Number
End Property
Public Property Get Number() As String
Number = mmNumber
End Property


Create another class, call in Products, with this code



Option Explicit

Private mmProducts As Collection

Function NewEnum() As IUnknown
Set NewEnum = mmProducts.[_NewEnum]
End Function

Public Function Add(Being As Product)
mmProducts.Add Being, Being.Name
End Function

Public Property Get Count() As Long
Count = mmProducts.Count
End Property

Public Property Get Items() As Collection
Set Items = mmProducts
End Property

Public Property Get Item(Index As Variant) As Product
Set Item = mmProducts(Index)
End Property

Public Sub Remove(Index As Variant)
mmProducts.Remove Index
End Sub

Public Function ProductName(ProductNumber As String) As String
Dim mpItem As Variant
For Each mpItem In mmProducts

If mpItem.Number = ProductNumber Then
ProductName = mpItem.Name
Exit Function
End If
Next mpItem
End Function

Private Sub Class_Initialize()
Set mmProducts = New Collection
End Sub

Private Sub Class_Terminate()
Set mmProducts = Nothing
End Sub


And here is test code emulating your code


Public Sub AddToProductClass()
Dim mpProducts As Products
Dim mpProduct As Product

Set mpProducts = New Products

Set mpProduct = New Product
With mpProduct

.Name = "abc"
.Number = "p2010 - 2"
mpProducts.Add mpProduct
End With
Set mpProduct = Nothing

Set mpProduct = New Product
With mpProduct

.Name = "abcd"
.Number = "221055"
mpProducts.Add mpProduct
End With
Set mpProduct = Nothing

Set mpProduct = New Product
With mpProduct

.Name = "abcde"
.Number = "scf - 15475"
mpProducts.Add mpProduct
End With
Set mpProduct = Nothing

For Each mpProduct In mpProducts
Debug.Print mpProduct.Name
Next mpProduct

If mpProducts.ProductName("p2010 - 2") = "abc2" Then
MsgBox "perfect"
End If

Set mpProducts = Nothing

End Sub

Paul_Hossler
03-26-2008, 10:29 AM
A less elegant way than XLD's would be to use corresponding arrays, and use MATCH() to lookup the index in Names and that result to pull data from the other arrays


Option Explicit
Sub Demo()

Dim aryNames(1 To 1000) As String
Dim aryNumbers(1 To 1000) As String
Dim rTemp As Range
Dim i As Long

'fill for test
For i = LBound(aryNames) To UBound(aryNames)
aryNames(i) = "NO"
aryNumbers(i) = "AAA-12345"
Next i
'put in test value to find
aryNames(567) = "YES"
aryNumbers(567) = "ZZZ-98765"

i = 0
On Error Resume Next
' i = Application.WorksheetFunction.Match("YES123", aryNames, 0)
i = Application.WorksheetFunction.Match("YES", aryNames, 0)
On Error GoTo 0

If i = 0 Then
MsgBox "Not Found"
Else
MsgBox "Product number = " & aryNumbers(i)
End If
End Sub


The second array could be based on a User Defined Type. The only constraint that I see would be the array to be MATCHed can only be a 1 dimensional array.

Paul

troelsi
03-27-2008, 03:30 AM
Hi thanks for your answers.

I'm interested in the fastest method, since my code is somewhat slow.
XLD: Your code using classes is clearly more elegant than what I do now, but I don't think it's faster, since your code also runs through the array/collection until it find the corresponding index number.

Does anyone know if the match function is a faster method than cycling through the arrays using for next loops.

Bob Phillips
03-27-2008, 03:57 AM
I thought you were looking for a method whereby you avoid the loops within YOUR code. My way is more elegant and more extensible, but I agree no faster.

Using two arrays and using match is definitley faster than looping, after a certain sized array. MATCH is a worksheet function, so the call to that incurs a performance hit, which on a small array would be worse.

You could also extend the class method to have two arrays and use MATCH. You could (should?) even have the double arrays and have some logic to determine whether to use loops or MATCH. Or even, if the data is ordered, and the class could do that as well, you could binary chop it. The big advantage of the class is that you can get a basic version working, implement it, then improve the class independently, then re-introduce it. Abstracting the logic is a powerful ally.

troelsi
03-27-2008, 04:17 AM
I have thought of doing some binary chopping, but since my productnumbers contain letters I'm not sure how to do it.
My arrays have 250 indexes, in your opinion does that justify the use of the match function?

Bob Phillips
03-27-2008, 04:41 AM
The problem is not so much the size of the array, but the incidence of matching. If the answer is always in the first dozen elements, regardless of whether the array has 20 elements or 20 million, looping will be instantaneous.

Having said that, cannot create a test where Match is ever faster, and as it is not pure VB, maybe loops are the way to go?

troelsi
03-27-2008, 04:47 AM
Ok, thanks for your input XLD I really appreciate it.

Paul_Hossler
03-27-2008, 07:18 AM
Q: you said that you "have the data stored in a user-defined array". That would imply that it gets loaded from somewhere, like a worksheet or external file. Do you need to load in into a VBA array at all? Could you work with the external source directly?

Q: How do you load in it? If you're already looping through an external source to build your array, I'd consider building a collection with the
Product as key as I pull it in (or once it's in), and thereafter extract the other data using the Product as the collection index. At least VBA wouldn't have to loop thru the collection when you need Number or other data.

Paul

troelsi
03-27-2008, 08:21 AM
Yes the data gets loaded from a worksheet, and I'm almost certain that it's most effective to load the data into a vba-array otherwise my code would have to cycle the the rows in the worksheet in order to look up the product-number in question.

I'm looping through the worksheet to build my array. And yes I do agree with you that it would be a good idea to build a collection with the product-number as the collection index. I just don't know how to do it.
I know how to create a collection with a normal index(integers), but I don't know how to change that index. Could you please show me how.

Thanks a lot.

Bob Phillips
03-27-2008, 08:51 AM
The quickest way by far would be to leave them in the ranges, have some formula in there that looks up a value in a cell against the product number range, return the product name. The VBA would then load the lookup value and read the forula cell, that is all.

troelsi
03-27-2008, 10:20 AM
I don't get that XLD, that means that my code would have to switch between the worksheet and the vba-code each time I needed some data.
Are you sure that's the fastest way?
What kind of formula did you have in mind?

Thanks for your patience.

Bob Phillips
03-27-2008, 10:28 AM
No it wouldn't, unless you mean the data table, but you said you were getting that from worksheet ranges. It writes to the worksheet, the worksheet recalculates (amzingly quickly) then the VBA just reads off that formula.

It's fast because it is utilising functions written by some great coders, who are writing at low-level code, who have access to all of the OS back-doors. It just doesn't get any quicker.

In my little test, I just used a VLOOKUP.

troelsi
03-27-2008, 10:55 AM
I'm sorry but I'm getting a little confused here. Not sure how I should distinguish between worksheet, datatable and worksheet ranges in this particular context. I'm sorry if I didn't explain myself good enough...
I have a worksheet which contains a large data-table(250 rows) each row represents a productnumber and each column represents an attribute like productname, inventorylevels, machinelines, productiontime and so forth.
I'm using a vba-code to constuct a production-schedule this involves several permutations and with each permutation I have to recalculate the inventorylevels amongst other things. This means that the code would have to read from the data-table many times.

Given the above, is VLOOKUP stil the fastest method?

Trevor
03-27-2008, 11:15 AM
I know this isn't a code change but since VBA in inerpreted not compiled (and I had a simler situation, to fix it i just moved I vaidation procedure in the code, so my suggestion would be to move your

For i = LBound(arr) To UBound(arr)
If arr(i).productnumber = p2010 - 2 Then
MsgBox "perfect"
End If

to just above your arr(i) =ABC, 'may not help but I say its worth a shot

Bob Phillips
03-27-2008, 11:16 AM
That was my understanding.

The thing is that you would have to do many lookups into an array or many loops through the array, so the many is not the governing factor. The other thing is that Excel is doing the VLOOKUP, not the VBA, so I think it is till likely to be the quickest.

troelsi
03-27-2008, 02:58 PM
I've been doing some experiments now. And it seems that given the way that I'm currently using vlookup it's faster to cycle through the arrays. Based on 2 mio. random productnumbers that I had to look up in a table with 250 rows. It took 93 seconds to loop through the arrays and 140 second using vlookup.
Here is the code:


Option Base 1
Option Explicit
Type pft
varenr As String
Recept As String
End Type
Global p() As pft
Sub Master()
Dim CycleTime, lookuptime As Integer
Dim antalpf As Integer
Dim find() As String
Dim i As Integer
Dim j As Long
Dim AntIte As Long
Dim TempTime As Date
AntIte = 2000000
ReDim find(AntIte)
Worksheets("ark1").Activate
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
antalpf = Selection.Cells.Count
ReDim p(antalpf) As pft
For i = 1 To antalpf
p(i).varenr = Cells(1 + i, 1)
p(i).Recept = Cells(1 + i, 13)
Next i
For j = 1 To AntIte
Randomize
find(j) = p(Int((antalpf - 1 + 1) * Rnd + 1)).varenr
Next j
TempTime = Time
For j = 1 To AntIte
Call cycle(find(j))
Next j
CycleTime = DateDiff("s", TempTime, Time)
Debug.Print CycleTime
Stop
TempTime = Time
For j = 1 To AntIte
Call lookup(find(j))
Next j
lookuptime = DateDiff("s", TempTime, Time)
Debug.Print lookuptime
End Sub

___

Function cycle(find As String)
Dim i As Integer
For i = LBound(p) To UBound(p)
If p(i).varenr = find Then
cycle = p(i).Recept
Exit Function
End If
Next i
End Function

____

Function lookup(varenr As Variant)
On Error GoTo errorhandler
Dim kolonne As Integer
Dim r1 As Range
Set r1 = Range("A2:p250")
kolonne = 13
If IsNumeric(varenr) Then
lookup = WorksheetFunction.VLookup(Val(varenr), r1, kolonne, False)
Else
lookup = WorksheetFunction.VLookup(varenr, r1, kolonne, False)
End If
Exit Function
errorhandler:
lookup = 0
End Function

Bob Phillips
03-27-2008, 06:23 PM
You are completely misunderstanding what I am saying.

I said don't load arrays, leave the data in the ranges on the worksheets.

I said don't use worksheetfunctions in VBA, but create the function in the worksheet itself and just load the lookup cell and read the result cell in VBA.

Using VLOOKUP in VBA would be no better than MATCH, and as I said earlier, I couldn't create a aituation where MATCH was faster than a lopp, so I am sure I couldn't create one where VLOOKUP is faster.

troelsi
03-28-2008, 03:12 AM
I have changed the above lookup function to the following:


Function lookup(find As String)
Cells(2, 18) = find
lookup = Cells(2, 20)
End Function


I have the VLOOKUP formula in cell(2,20). I pass the productnumber that has to be looked up to the cell(2,18) and the VLOOKUP formula reads the productnumber from cell(2,18). With this setup looping is still significantly faster.
I'm not sure if this is what you where thinking about XLD, but I don't how else to pass the productnumber(find) value to the formula.

Bob Phillips
03-28-2008, 05:16 AM
BTW, if you are going to time different approaches, you have to have a level playing field, your macros were far from even in their approach.

This is a far more objective test, and here you will see that the WS function is much faster, primarily because you are not loading from the worksheet



Sub Master()
Dim find() As String
Dim i As Long, j As Long
Dim AntIte As Long
Dim nTime As Double
Dim kolonne As Integer
Dim r1 As Range
Dim result

AntIte = 200000

ReDim find(AntIte)
For j = 1 To AntIte
Randomize
find(j) = Int(Rnd * 250 + 1)
Next j

nTime = Timer
ReDim p(antalpf) As pft
For i = 1 To antalpf
p(i).varenr = Cells(1 + i, 1)
p(i).Recept = Cells(1 + i, 13)
Next i
For j = 1 To AntIte
For i = LBound(p) To UBound(p)
If p(i).varenr = Cells(find(j), 1).Value Then
result = p(i).Recept
Exit For
End If
Next i
Next j
Debug.Print "Loop :" & Timer - nTime

nTime = Timer
Set r1 = Range("A2:P250")
kolonne = 13
For j = 1 To AntIte
result = WorksheetFunction.VLookup(Cells(find(j), 1).Value, r1, kolonne, False)
Next j
Debug.Print "WS Function :" & Timer - nTime
End Sub

troelsi
03-28-2008, 06:40 AM
MY MAN!