I am trying to figure out a loop logic to get all possible permutations where I add a set value to each item in a set array iLoop number of times. I’m gonna try my best to explain what I am looking for.
I have a set value “StrokeValue” and a set array “DistanceMatesArray”
Dim StrokeValue as single
Dim DistanceMatesArray as variant
StrokeValue = 300
DistanceMatesArray = Array(300, 300, 300, 300)
Now I need to loop through each possible result where I add StrokeValue to each Item which in the first loop would result in possible DistanceMatesArrays:
The tricky part is when I want to add StrokeValue more than once and get every outcome where I added StrokeValue iLoop number of time “AllowedActions” resulting in a list such as:
I kind of suspect that I need a 2D array to store all the results from previous loop., that’s why in the example the rows are coloured to indicate which one row was taken as a starting point to add the StrokeValue once
What I got so far looks like this:
Public StrokeValue As Single
Public DistanceMatesArray As Variant
Public iError As Long
Public NumberOfCombinations As Long
Public x As Long
Public y As Long
Public i As Long
Option Explicit
Sub Test()
'Declare variables
Dim PreviousLoopResultsArray As Variant
Dim NextLoopResultsArray As Variant
Dim iresults As Long
Dim iLoop As Long
Dim iPreviousResult As Long
'Set variables
StrokeValue = 300
'Array
DistanceMatesArray = Array(300, 300, 300, 300)
ReDim NextLoopResultsArray(0, UBound(DistanceMatesArray))
For i = LBound(DistanceMatesArray) To UBound(DistanceMatesArray)
NextLoopResultsArray(0, i) = DistanceMatesArray(i)
Next i
'------------------------------------------------------
'Loop
Do While iError = NumberOfCombinations
'Try DistanceMatesArray
For i = 0 To iresults
For x = 0 To UBound(DistanceMatesArray) 'Loop horizontally
DistanceMatesArray(x) = NextLoopResultsArray(i, x)
Next x
Debug.Print Join(DistanceMatesArray)
'TRY HERE
Next i
'Array
PreviousLoopResultsArray = NextLoopResultsArray
'Array
If iLoop <> 0 Then
For x = 0 To UBound(DistanceMatesArray) 'Loop horizontally
DistanceMatesArray(x) = PreviousLoopResultsArray(iPreviousResult, x)
Next x
End If
'Set variables
iLoop = iLoop + 1
iPreviousResult = 1
iresults = ((UBound(DistanceMatesArray) + 1) ^ iLoop) - 1
ReDim NextLoopResultsArray(iresults, UBound(DistanceMatesArray))
'Populate NextLoopResultsArray
For y = 0 To iresults 'Loop vertically
If y Mod (UBound(DistanceMatesArray) + 1) = 0 And y <> iresults And y <> 0 Then
For x = 0 To UBound(DistanceMatesArray) 'Loop horizontally
DistanceMatesArray(x) = PreviousLoopResultsArray(iPreviousResult, x)
Next x
iPreviousResult = iPreviousResult + 1
End If
For x = 0 To UBound(DistanceMatesArray) 'Loop horizontally
NextLoopResultsArray(y, x) = DistanceMatesArray(x)
With ThisWorkbook.Worksheets(1).Cells(y + 1, x + 1)
.Value = NextLoopResultsArray(y, x)
End With
Next x
Next y
'Modify NextLoopResultsArray
x = 0
For y = 0 To iresults 'Loop vertically
NextLoopResultsArray(y, x) = NextLoopResultsArray(y, x) + StrokeValue
With ThisWorkbook.Worksheets(1).Cells(y + 1, x + 1)
.Value = NextLoopResultsArray(y, x)
.Interior.Color = vbYellow
End With
If x + 1 > UBound(DistanceMatesArray) Then
x = 0
Else
x = x + 1
End If
Next y
'Set variables
iPreviousResult = 0
'Excel reset
For i = 1 To (UBound(DistanceMatesArray) + 1)
Columns(i).Clear
Next i
Loop
End Sub
At the end of the loop I am expecting to have each one row as DistanceMatesArray i.e. one of them would now be
DistanceMatesArray = array(300,600,600,300)
Where it added StrokeValue twice.
Would someone, please, help me figure out a shorter and simpler logic behind this?
EDIT:
Results expected after running it up to 3 loops looks like this:
And without duplicate outcomes
Continuing to try and figure out the logic of it, maybe now someone get’s a betetr idea for what I am lookign for and can help
No need to mention that it’s an infinite loop – I know that and That’s the point, it needs to go on untill I validate the right array in which case iError <> NumberOfCombinations.
Been able to learn more about arrays, so I consider this a big win. The code took in account the duplicates but for now your iterations are hardset (could easily ask how many iterations with an inputbox), not in the endless loop you had set up, hope that rework won’t be too much. Some variables are reworked, I tried to keep most of your original ones though.
Hope it’s all clear and works for you 🙂