Help creating Macro - 5 numbers adding up to a value

[iainfitzy]

Not sure how best to word this one!

I am looking to create a Macro to create multiple lines of data that add up to a certain value

10 20 30 -20 60 100
10 80 -40 -20 70 100
20 20 20 30 10 100
10 10 10 10 60 100
10 20 20 -10 60 100
-20 20 10 10 80 100
100 0 0 0 0 100
0 100 0 0 0 100
0 0 100 0 0 100

Columns 1-5 are the values, with column 6 the sum of the previous 5 columns


The criteria I need are as follows :-

5 columns each with values in them that add up to column 6 (100).
The numbers in Columns 1-5 should be multiples of 10
The numbers in Columns 1-5 should be from (-100 to 100)
I would like it to produce every possible number combination

Is there any possible way of doing this via a Macro? I have no idea how many lines of data this will produce - and i would guess it would need logic to check that it has not appeared before - could mean some amount of time number crunching. I would assume this has been done before but I have scoured the web with no solution.

Any help much appreciated,

Iain

 

[hurgadion]

Hi,
try using the following macro:

Sub FiveHundred()
Dim NoDupes As New Collection
Dim l&, j&, x&, y&, tbl1()


Randomize
For l = 1 To 100000
  x = 4
  ReDim tbl(1 To x)
  For j = 1 To 4
    tbl(j) = -100 + 10 * Round((20 * Rnd), 0)
  Next j
  a = Application.Sum(tbl)
  If Abs(a - 100) <= 100 Then
    x = x + 1
    ReDim Preserve tbl(1 To 5)
    tbl(5) = 100 - a
  End If
  
     On Error Resume Next
     If x = 5 Then
         c = Join(tbl, ";")
         NoDupes.Add 1, CStr(c)
         If Err.Number = 0 Then
              y = y + 1
              ReDim Preserve tbl1(1 To 5, 1 To y)
              For j = 1 To 5
                  tbl1(j, y) = tbl(j)
              Next j
         End If
    End If
Next l

Cells(1, 1).Resize(y, 5) = Application.Transpose(tbl1)
End Sub

This generates some random Solutions satisfying Your Conditions. This macro can be useful for You, best regards.

 

[iainfitzy]

Hi,
try using the following macro:

Sub FiveHundred()
Dim NoDupes As New Collection
Dim l&, j&, x&, y&, tbl1()


Randomize
For l = 1 To 100000
  x = 4
  ReDim tbl(1 To x)
  For j = 1 To 4
    tbl(j) = -100 + 10 * Round((20 * Rnd), 0)
  Next j
  a = Application.Sum(tbl)
  If Abs(a - 100) <= 100 Then
    x = x + 1
    ReDim Preserve tbl(1 To 5)
    tbl(5) = 100 - a
  End If
  
     On Error Resume Next
     If x = 5 Then
         c = Join(tbl, ";")
         NoDupes.Add 1, CStr(c)
         If Err.Number = 0 Then
              y = y + 1
              ReDim Preserve tbl1(1 To 5, 1 To y)
              For j = 1 To 5
                  tbl1(j, y) = tbl(j)
              Next j
         End If
    End If
Next l

Cells(1, 1).Resize(y, 5) = Application.Transpose(tbl1)
End Sub

This generates some random Solutions satisfying Your Conditions. This macro can be useful for You, best regards.

Many thanks for this - is a vast improvement on what I had. I will use it to see what results I get.

Ultimately though I really need every possible combination covered if anyone else had any ideas - a variable should also never be over 100 in columns 1-5.

Again - thanks for taking the time to help me out hurgadion

Thanks,

Iain

 

[iainfitzy]

A shameless bump