Excel Macro Programing Problem

[Mr.Nemo]

Hello,

I have got a question regarding how to solve a problem using exce
macro. Here it goes :

There are n=4 variables : x1,x2,x3,x4, each can take r=3 differen
values: A,B,C. See below:
X1 A1 B1 C1
X2 A2 B2 C2
X3 A3 B3 C3
X4 A4 B4 C4
The final equation to be computed is y=x1+x2+x3+x4. Now, there are nPr
24 different values all the variables can assume and therefore ther
will be 24 different y values the above table and equation ca
generate.
Problem Statement: Generate a macro which will list all the y value
when the values of n and r are supplied.

I would really appreciate is someone could help me out with the macr
code.

Thanks in advance

 

[Ben McClave]

Hi Mr. Nemo,

I found a code that came close to doing this here: http://stackoverflow.com/questions/...-create-every-possible-combination-of-a-range.

I have adapted the solution found there to your data (add four rows of data where the value from each row can be one of three potential values). This sub will populate the permutations beginning in cell G6.

I added some lines to also show the values being added or the ranges being added in case you are interested in where the figures came from.

Hope this helps.

Ben

Sub Perumutations()
'Adapted from a post at: _
http://stackoverflow.com/questions/10692653/ _
excel-vba-to-create-every-possible-combination-of-a-range

'This code assumes your data is stored in the range A1:C4 _
with each row being added together and all possible values _
of each row being stored in columns. (i.e. row 1 has three _
possible values, stored in cells A1, B1, and C1)

Dim x As Long
Dim i As Long, j As Long, k As Long, l As Long
Dim lastrow As Long

x = 3 'How many possible values?

Application.ScreenUpdating = False

lastrow = 6 'Permutations to begin in row 6 of columns F & G

For i = 1 To x: For j = 1 To x
For k = 1 To x: For l = 1 To x
Range("G" & lastrow).Value = Cells(1, i).Value + _
Cells(2, j).Value + _
Cells(3, k).Value + _
Cells(4, l).Value
'Uncomment next line to show the calculations
'Range("F" & lastrow).Value = Cells(1, i).Value & "+" & _
Cells(2, j).Value & "+" & _
Cells(3, k).Value & "+" & _
Cells(4, l).Value & "="
'Uncomment next line to show cell references
'Range("F" & lastrow).Value = Cells(1, i).Address & "+" & _
Cells(2, j).Address & "+" & _
Cells(3, k).Address & "+" & _
Cells(4, l).Address & "="
lastrow = lastrow + 1
Next: Next
Next: Next


Application.ScreenUpdating = True
End Sub

 

[joeu2004]

There are n=4 variables : x1,x2,x3,x4, each can take r=3 different
values: A,B,C. See below:
X1 A1 B1 C1
X2 A2 B2 C2
X3 A3 B3 C3
X4 A4 B4 C4
The final equation to be computed is y=x1+x2+x3+x4.
Now, there are nPr = 24 different values all the variables can assume

The number of sums is r^n (r to the power of n), not nPr.

Consider the case when n=4 and r=5; that is, x1 can have the values
a1,...,e1 for example.

The value 4P5 = PERMUT(4,5) is invalid. In fact, there are 5^4 = 625 sums.

Problem Statement: Generate a macro which will list all the y values
when the values of n and r are supplied.

You also need to supply the r values for each of the n variables.

Suppose the values are in an n-by-r range of cells, and at least the
upper-left cell is selected. Also, the r+1 column must be cleared.

For example, suppose A1:E1 is 1, 2, 3, 4, 5. A2:E2 is 10,...,50. A3:E3 is
100,...,500. And A4:E4 is 1000,...,5000. This will make it easy to see
that all sums are formed. Also, clear column F.

The following macro will put all r^n sums into the r+1 column.
-----

Option Explicit

Sub allSums()
Dim x As Variant
Dim nR As Long, nC As Long, nY As Long
Dim i As Long, r As Long, c As Long
' copy matrix of values into x(nR,nC).
' assume at least 2 rows and 2 columns of values.
' assume there are no values in the nC+1 column.
x = Range(Selection(1), Selection(1).End(xlToRight).End(xlDown))
nR = UBound(x, 1)
nC = UBound(x, 2)
nY = nC ^ nR
ReDim y(0 To nY - 1, 1 To 1) As Double
For i = 0 To nY - 1
c = i
For r = 1 To nR
y(i, 1) = y(i, 1) + x(r, c Mod nC + 1)
c = c \ nC
Next
Next
Selection(1).Offset(0, nC).Resize(nY) = y
End Sub