Creating a collection in a class

[Guest]

Hello Guys,

My previous post wasn't clear enough. So i'll detail this one a bit more:

Currently i have this function I USE in a worksheet:

Function Toef(sDate As Date, uitVM, inVM, uitNM, inNM, NaR, CAD As Single)
Dim hCol As New CollClass
Set hCollection = New Collection
Set hColRange = Worksheets("CODE").range("G5:G18")
For hCItemCounter = 1 To 15
hCollection.Add Item:=hColRange.Cells(hCItemCounter).Value
Next hCItemCounter
For Each hCItem In hCollection
If hCItem = sDate Then
'do a calculation
Exit Function
Else
Toef = ""
End If
Next hCItem
End Function

Because this function is used in a worksheet, this is kinda heavy in the
sense that the collection should only be created once, not each time for
every cell this function is used. So i've tried to put a part of this
function in a class named CollClass:

Public hCollection As Collection
Public hCItemCounter As Long
Public hCItem As Variant

Public Sub CreateRange()
Public hColRange As range
Set hCollection = New Collection
Set hColRange = Worksheets("CODE").range("G5:G18")
For hCItemCounter = 1 To 15
hCollection.Add Item:=hColRange.Cells(hCItemCounter).Value
Next hCItemCounter
End Sub

Next i would change my Function into:
(in the second line i'm creating an instance of the class, i thought this
would be enough). However: If I use this function, i get this error:

The cell is filled with the value: #VALUE!
"A value in the formula has a incorrect datatype"

Any suggestions guys?

Function Toef(sDate As Date, uitVM, inVM, uitNM, inNM, NaR, CAD As Single)
Dim hCol As New CollClass
For Each hCItem In hCollection
If hCItem = sDate Then
'do calculation
Exit Function
Else
Toef = ""
End If
Next hCItem
End Function

With regards everyone,

 

[NickHK]

Not sure why you are using a class/collection in a worksheet function.
Is this not basically the same as doing a VLOOKUP/MATCH for sDate?

Also your structure seems strange as you either return "" or nothing at all.
And no data type indicated for the return value, or for most of the
argument, which will default to Variant.
And it would better to pass the search range into the function as an
argument, rather than hard-coding it inside.

Something like this, but add error trapping:

Function Toef(sDate As Date, SearchRange As Range, uitVM, inVM, uitNM, inNM,
NaR, CAD As Single) As Double

If Application.WorksheetFunction.Match(sDate, SearchRange, 0) > 0 Then
Toef = 10 * 10 'Some calculation
Else
Toef = 0
End If

End Function

NickHK

 

[Guest]

The reason why I did it this way is because I want it to be as easily as it
can be when something within the range needs to be changed --> everyone can
change something within a range, not within code.

But that's not the issue here. I wanted to avoid having long, tedious
formulas, so i started to program them. So my function works great, it does
what it needs to be doing, but I just don't want to create the collection
everytime the formula is used within a cell --> only once. The function in
the module:

Function Toef(sDate As Date, uitVM, inVM, uitNM, inNM, NaR, CAD As Single)
As String
For Each hCItem In hCollection
If hCItem = sDate Then
' do calculation: TOEF = x + y +z + ...
Exit Function
Else
Toef = ""
End If
Next hCItem
End Function

the class ColClass:

Public hCollection As Collection
Public hCItemCounter As Long
Public hCItem As Variant
Public hColRange As range
Public Sub CreateVCode()
Public hColRange As range
Set hCollection = New Collection
Set hColRange = Worksheets("CODE").range("G5:G18")
For hCItemCounter = 1 To 15
hCollection.Add Item:=hColRange.Cells(hCItemCounter).Value
Next hCItemCounter
End Sub

 

[NickHK]

I still don't see the point of your approach or understand your logic, as
your decribed situation is completely normal but..

Assuming you will always use the same collection:

Private Coll As Collection
Const RangeAddress As String = "A1:A10"
Dim Cell As Range

Public Function DoCalc(Val1 As Long) As Double
Dim CollVal As Variant

If Coll Is Nothing Then
Set Coll = New Collection
For Each Cell In Range(RangeAddress)
Coll.Add Cell.Value
Next
End If

For Each CollVal In Coll
If CollVal = Val1 Then
DoCalc = Val1 * Rnd()
Exit Function
End If
Next

DoCalc = 0

End Function

NickHK