Passing indexed array value to VBA function

[futuregolfpro]

HERE IS A CODE SNIPPIT

Sub randomgen()
Dim randomWeights() As Integer
Dim extraWeights() As Integer
Dim temp() As Integer
Dim lastNumber() As Integer
Dim firstNumber() As Integer
Dim extras(), randoms()

ReDim unsortedRandoms(Cells(2, 2) * 5)
ReDim unsortedExtras(Cells(3, 2) * 5)
ReDim firstNumber(Cells(4, 2))
ReDim lastNumber(Cells(4, 2))
ReDim randomWeights(Cells(4, 2))
ReDim extraWeights(Cells(4, 2))

randomWeights(q) = Round((lastNumber(q) - firstNumber(q)) *
Cells(2, 2) * 5 / totalRange)
extraWeights(q) = Round((lastNumber(q) - firstNumber(q)) * Cells(3,
2) * 5 / totalRange)

temp = RandomNumbers(lastNumber(q), firstNumber(q),
(randomWeights(q) + extraWeights(q)))

end sub

Public Function RandomNumbers(Upper As Integer, _
Optional Lower As Integer = 1, _
Optional HowMany As Integer = 1, _
Optional Unique As Boolean = True) As Variant

end function

END OF CODE SNIPPIT

I want to call the RandomNumber function using the values in those
arrays at index q. What am I doing wrong? I get a runtime error 13 type
mismatch on the RandomNumbers function call.

Thanks in advance,
Phil

 

[Alan Beban]

You haven't provided enough data for me to work with the snippet. E.g.,
what is q? What is totalRange? With what are lastNumber and firstNumber
initialized?

Alan Beban

 

[futuregolfpro]

Thanks for the reply. Here is the whole subroutine.

Sub randomgen()
'Declare temporary arrays
Dim randomNums(), unsortedRandoms(), unsortedExtras()
Dim randomWeights() As Integer
Dim extraWeights() As Integer
Dim temp() As Integer
Dim lastNumber() As Integer
Dim firstNumber() As Integer
'randoms will hold the sorted random sample numbers
'extras will hold the sorted substitutes
Dim extras(), randoms()
'declare counters
Dim a, b, i, j, k, m, p, q, currentRandom, totalRange, counterR,
counterE As Integer

ReDim unsortedRandoms(Cells(2, 2) * 5)
ReDim unsortedExtras(Cells(3, 2) * 5)
ReDim firstNumber(Cells(4, 2))
ReDim lastNumber(Cells(4, 2))
ReDim randomWeights(Cells(4, 2))
ReDim extraWeights(Cells(4, 2))

totalRange = 0
For p = 0 To Cells(4, 2) - 1
firstNumber(p) = Application.InputBox(Prompt:="Enter range
" & p + 1 & " start", Type:=1)
lastNumber(p) = Application.InputBox(Prompt:="Enter range "
& p + 1 & " end", Type:=1)
totalRange = totalRange + lastNumber(p) - firstNumber(p)
Next p

'If there is more than one range
counter = 0
If Cells(4, 2) >= 1 Then
'Determine numbers to generate for each range. weighted average
For q = 0 To Cells(4, 2) - 2
randomWeights(q) = Round((lastNumber(q) - firstNumber(q)) *
Cells(2, 2) * 5 / totalRange)
counterR = counterR + randomWeights(q)
extraWeights(q) = Round((lastNumber(q) - firstNumber(q)) *
Cells(3, 2) * 5 / totalRange)
counterE = counterE + extraWeights(q)
Next q
randomWeights(q) = Cells(2, 2) * 5 - counterR
extraWeights(q) = Cells(3, 2) * 5 - counterE

'Generate numbers for each range and separate randoms from
substitutes
counterR = 0
counterE = 0
For q = 0 To Cells(4, 2) - 1
'get random numbers for current range
Cells(5, 2) = extraWeights(q)
temp = RandomNumbers(lastNumber(q), firstNumber(q),
(randomWeights(q) + extraWeights(q)))
'put randoms in unsorted randoms
For p = 0 To randomWeights(q)
unsortedRandoms(p + counterR) = temp(p)
Next p
counterR = counterR + randomWeights(q)
'put substitutes in unsorted extras
For m = randomWeights(q) To randomWeights(q) +
extraWeights(q)
unsortedExtras(m + counterE) = temp(p)
Next m
counterE = counterE + extraWeights(q)
Next q

'Only one range
Else
'Call random number function and put result in randomNums
randomNums = RandomNumbers(Worksheets("temp data").Cells(1, 2),
Worksheets("temp data").Cells(1, 1), (Cells(2, 2) + Cells(3, 2)) * 5)

'Separate substitutes from random sample
For a = 0 To (Cells(2, 2) * 5 - 1)
unsortedRandoms(a) = randomNums(a)
Next a
For b = Cells(2, 2) * 5 To (Cells(3, 2) + Cells(2, 2)) * 5 - 1
unsortedExtras(b - (Cells(2, 2) * 5)) = randomNums(b)
Next b
End If


'Sort random sample and substitutes arrays
randoms = Array_Sort(unsortedRandoms)
extras = Array_Sort(unsortedExtras)

'Clear Output cells of formatting and data
ClearBorders Range("B10:F200")
Range("B10:F200").Font.Bold = False
Range("B10:F200").MergeCells = False
Range("B10:F200").Clear

'Print out random sample numbers
currentRandom = 0
For i = 10 To (Cells(2, 2) + 9)
For j = 2 To 6
Cells(i, j) = randoms(currentRandom)
currentRandom = currentRandom + 1
Next j
Next i
'Put border around random numbers
Range(Cells(10, 2), Cells(Cells(2, 2) + 9, 6)).BorderAround
Weight:=xlThin

'Print Substitutes title
Range(Cells(Cells(2, 2) + 11, 2), Cells(Cells(2, 2) + 11,
6)).MergeCells = True
Range(Cells(Cells(2, 2) + 11, 2), Cells(Cells(2, 2) + 11,
6)).Font.Bold = True
Range(Cells(Cells(2, 2) + 11, 2), Cells(Cells(2, 2) + 11,
6)).BorderAround Weight:=xlThin
Range(Cells(Cells(2, 2) + 11, 2), Cells(Cells(2, 2) + 11, 6)).Value
= "Substitutes"
Range(Cells(Cells(2, 2) + 11, 2), Cells(Cells(2, 2) + 11,
6)).HorizontalAlignment = xlCenter

'Print substitute numbers
currentRandom = 0
For k = Cells(2, 2) + 12 To Cells(3, 2) + Cells(2, 2) + 11
For m = 2 To 6
Cells(k, m) = extras(currentRandom)
currentRandom = currentRandom + 1
Next m
Next k
Range(Cells(Cells(2, 2) + 12, 2), Cells(Cells(3, 2) + Cells(2, 2) +
11, 6)).BorderAround Weight:=xlThin




Worksheets("temp data").Range("A1:B25").Clear

End Sub

 

[Alan Beban]

Now that I asked for it I don't know that I want it. Is the problem
simply that the function you posted doesn't perform any function? In
the form in which you posted it it doesn't.

Alan Beban

 

[futuregolfpro]

Hehe, I didnt think you would want to look at that mess.

The problem is just that I get a runtime error 13 type mismatch on the
RandomNumbers function call. It doesnt seem to like the firstNumber(q)
argument for the function. The function is defined to accept integers,
so I am thinking that its not recognizing this number in the array as
an integer.

Is the application.inputbox statement correct to put an integer in the
array? Can I not call the function with the array like it is?

Thanks again.

 

[Alan Beban]

I can't believe all that stuff is necessary to illustrate the problem.
Can't you just do it with something like the following?

Sub test21()
Upper = Application.InputBox(Prompt:="Enter range" _
& p + 1 & " start", Type:=1)
Debug.Print RandomNumbers(Upper)
End Sub
Public Function RandomNumbers(Upper As Integer, _
Optional Lower As Integer = 1, _
Optional HowMany As Integer = 1, _
Optional Unique As Boolean = True) As Variant
RandomNumbers = Upper
End Function

At any rate, try replacing

Public Function RandomNumbers(Upper As Integer, _
Optional Lower As Integer = 1, _
Optional HowMany As Integer = 1, _
Optional Unique As Boolean = True) As Variant

end function

with

Public Function RandomNumbers(Upper As Variant, _
Optional Lower As Variant = 1, _
Optional HowMany As Variant = 1, _
Optional Unique As Variant = True) As Variant

end function

and post back.

Alan Beban

 

[NickHK]

It not the input arguments that are the problem, it the function's return
value.
Or rather it's the variables you are attempting to assign to the return
value.

Will you function return an array of integers or (an array in) a variant or
an array of variant ?
Dim temp() As Integer
Public Function RandomNumbers(<arguments>) As Variant
Dim randomNums(), unsortedRandoms(), unsortedExtras()

NickHK

Hehe, I didnt think you would want to look at that mess.

The problem is just that I get a runtime error 13 type mismatch on the
RandomNumbers function call. It doesnt seem to like the firstNumber(q)
argument for the function. The function is defined to accept integers,
so I am thinking that its not recognizing this number in the array as
an integer.

Is the application.inputbox statement correct to put an integer in the
array? Can I not call the function with the array like it is?

Thanks again.

----------- SNIP ------------------------

 

[futuregolfpro]

Thanks Nick, that was it. I changed temp to a variant and all is well.