Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default Passing indexed array value to VBA function

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

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default Passing indexed array value to VBA function

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 wrote:
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

wrote:
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


  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 200
Default Passing indexed array value to VBA function

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

wrote:
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 wrote:
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

wrote:
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


  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default Passing indexed array value to VBA function

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 wrote:
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

wrote:
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 wrote:
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

wrote:
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





  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 200
Default Passing indexed array value to VBA function

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

wrote:
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 wrote:
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

wrote:
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 wrote:
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

wrote:
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


  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4,391
Default Passing indexed array value to VBA function

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

wrote in message
oups.com...
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 wrote:
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

wrote:
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

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

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

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

'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)

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

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



  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default Passing indexed array value to VBA function

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

NickHK wrote:
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

wrote in message
oups.com...
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 wrote:
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

wrote:
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

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

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

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

'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)

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

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


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How can I use and indexed value as the name of an array for vlooku JimR Excel Worksheet Functions 2 October 1st 07 08:20 AM
Passing array from Access to Excel function Dale[_15_] Excel Programming 5 September 29th 05 07:30 PM
Sum from an indexed array/table [email protected] Excel Discussion (Misc queries) 1 May 17th 05 07:41 PM
Passing array of strings from DLL function to VBA Jag Man Excel Programming 0 January 12th 04 10:09 PM
Passing array to a function GB[_3_] Excel Programming 3 October 21st 03 09:59 AM


All times are GMT +1. The time now is 11:55 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"