Search code examples
arraysexcelvbarandomsampling

Fill array of random rumbers to sum in excel vba


I'm trying to create a sampling tool for which

I need to pick randomly generated numbers between 0 and 3000 in multiples of 500 such that their sum is a fixed number say 10000 in 12 slots

Over to that I need to run multiple iterations about 100000 to 1000000 (not decided yet.

My approach is to create a two dimensional array, put a constraint to validate the sum total of an iteration, and only if the condition is true enter it in the final data sample.

I'm making some very terrible mistakes with the following code could not figure out where... Help is appreciated

Public Sub Generatenums()
    Dim GRP() As Long, Random() As Long
    Dim RandomTotal As Long, t As Long, w As Long, i As Long, j As Long

    ReDim GRP(1 To 100, 1 To 12)
    ReDim Random(1 To 12)

    For i = 1 To 100
        For j = 1 To 12
            Random(j) = Int(Rnd() * 7) * 500
            RandomTotal = RandomTotal + Random(j)
        Next j

        If RandomTotal = 10000 Then
            For k = 1 To 12
                GRP(i, k) = Random(k)
            Next k
        End If
    Next i

    Range("A1").Select
    For t = 1 To 100
        For w = 1 To 12
            Cells(t, w).Value = GRP(t, w)
        Next w
    Next t
End Sub

Solution

  • Fantom, welcome to SO.

    The commentors are right: This will take a very long time to run.

    Instead of thinking of this as an array to fill as a certain sum, think of it as a Pachinko or Galton Board with 20 balls bouncing around and ending up in bins at the bottom. Why 20? Because you want a sum of 10000 in increments of 500, and consider 10000/500 = 20 as one ball.

    Now the program can run in linear time. You don't randomize the sums, you randomize which of the 12 slots the ball will fall into. Then you multiply how many balls are in each slot by 500 and your sum will always be 10000.

    One of the loops looks like this:

    For i = 1 To 20
      x = Rnd() * 12 + 1
      If x > 12 Then x = 12
      If x < 1 Then x = 1
      bin(x) = bin(x) + 1
    Next i
    

    Is that enough to solve your problem, or do you need some more?