Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How can I use and indexed value as the name of an array for vlooku | Excel Worksheet Functions | |||
Passing array from Access to Excel function | Excel Programming | |||
Sum from an indexed array/table | Excel Discussion (Misc queries) | |||
Passing array of strings from DLL function to VBA | Excel Programming | |||
Passing array to a function | Excel Programming |