Help modifiying code

[michaelsmith559]

I would like to modify the following code so that it only lists combinations that fall between a certain range. I am trying to add an if then statement but have not been able to get it to work. Does anyone know how to add a line or lines of code so that I can make this list only combinations that fall between: 5280.111 and 5280.537? Also, if the combinations fill up the column how can I make it continue to the next column or as many columns as needed? Thanks for any help. Here is the code:

Sub Combinations()
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
Dim CountComb As Long, lastrow As Long

Range("I2").Value = Now

Application.ScreenUpdating = False

CountComb = 0: lastrow = 2

For i = 1 To 32: For j = 1 To 40
For k = 1 To 47: For l = 1 To 44
For m = 1 To 38: For n = 1 To 34
Range("K" & lastrow).Value = Range("A" & i).Value & "," & _
Range("B" & j).Value & "," & _
Range("C" & k).Value & "," & _
Range("D" & l).Value & "," & _
Range("E" & m).Value & "," & _
Range("F" & n).Value
lastrow = lastrow + 1
CountComb = CountComb + 1
Next: Next
Next: Next
Next: Next

Range("I1").Value = CountComb
Range("I3").Value = Now

Application.ScreenUpdating = True
End Sub

 

[michaelsmith559]

I need to clarify that the values in ranges a:f must sum to values between 5280.111 and 5280.537

 

[michaelsmith559]

Here is how I have tried to modify the code and it gives a runtime error 1004 method range of object global failed. Code:

Sub Combinations2()
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
Dim CountComb As Long, lastrow As Long

Range("I2").Value = Now

Application.ScreenUpdating = False

CountComb = 0: lastrow = 2

If Range("A" & i).Value + Range("B" & j).Value + Range("C" & k).Value _
+ Range("D" & l).Value + Range("E" & m).Value + Range("F" & n).Value _
>= 5280.111 And Range("A" & i).Value + Range("B" & j).Value + Range("C" & k).Value _
+ Range("D" & l).Value + Range("E" & m).Value + Range("F" & n).Value <= 5280.537 Then

For i = 1 To 32: For j = 1 To 40
For k = 1 To 47: For l = 1 To 44
For m = 1 To 38: For n = 1 To 34

Range("K" & lastrow).Value = Range("A" & i).Value & "," & _
Range("B" & j).Value & "," & _
Range("C" & k).Value & "," & _
Range("D" & l).Value & "," & _
Range("E" & m).Value & "," & _
Range("F" & n).Value


lastrow = lastrow + 1
CountComb = CountComb + 1
Next: Next
Next: Next
Next: Next
End If
Range("I1").Value = CountComb
Range("I3").Value = Now

Application.ScreenUpdating = True
End Sub

 

[michaelsmith559]

Here is another example I am trying but I get an error of For Without Next:

Sub Combinations()
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
Dim CountComb As Long, lastrow As Long

Range("I2").Value = Now

Application.ScreenUpdating = False

CountComb = 0: lastrow = 2

For i = 1 To 32: For j = 1 To 40
For k = 1 To 47: For l = 1 To 44
For m = 1 To 38: For n = 1 To 34
Range("K" & lastrow).Value = Range("A" & i).Value & "," & _
Range("B" & j).Value & "," & _
Range("C" & k).Value & "," & _
Range("D" & l).Value & "," & _
Range("E" & m).Value & "," & _
Range("F" & n).Value
Range("L" & lastrow).FormulaR1C1 = "=test(RC[-1])"
If Range("L" & lastrow).Value >= 5280.111 And _
Range("L" & lastrow).Value <= 5280.537 Then
lastrow = lastrow + 1
CountComb = CountComb + 1
Next: Next
Next: Next
Next: Next
Else
Range ("K" & lastrow) And Range("L" & lastrow).ClearContents
Range("I1").Value = CountComb
Range("I3").Value = Now

Application.ScreenUpdating = True
End Sub

 

[michaelsmith559]

Here I have changed the code to what I want but I cannot get figure out where to put the end if. If it is left where it currently is then range"k" does not advance down the column. Where does the end if need to go? Thanks. Here is the code:

Sub Combinations()
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
Dim CountComb As Long, lastrow As Long

Range("I2").Value = Now

Application.ScreenUpdating = False

CountComb = 0: lastrow = 2

For i = 1 To 32: For j = 1 To 40
For k = 1 To 47: For l = 1 To 44
For m = 1 To 38: For n = 1 To 34
Range("K" & lastrow).Value = Range("A" & i).Value & "," & _
Range("B" & j).Value & "," & _
Range("C" & k).Value & "," & _
Range("D" & l).Value & "," & _
Range("E" & m).Value & "," & _
Range("F" & n).Value
Range("L" & lastrow).FormulaR1C1 = "=test(RC[-1])"
If Range("L" & lastrow).Value >= 5280.111 And _
Range("L" & lastrow).Value <= 5280.537 Then
Range("K" & lastrow).Value = Range("A" & i).Value & "," & _
Range("B" & j).Value & "," & _
Range("C" & k).Value & "," & _
Range("D" & l).Value & "," & _
Range("E" & m).Value & "," & _
Range("F" & n).Value

lastrow = lastrow + 1
CountComb = CountComb + 1
End If
Next: Next
Next: Next
Next: Next

Range("I1").Value = CountComb
Range("I3").Value = Now

Application.ScreenUpdating = True
End Sub

 

[ttdk1]

holy smoke, that's gonna take a long awhile to process. Plus, your code is so inefficient, it's gonna take even longer

 

[Ragnar1211]

Can you please describe what you are trying to accomplish... the six nested loops do not make a lot of sense currently you are looping through over 3 million cells.

 

[ttdk1]

here's the code. It uses arrays to speed up the process, and only displays the valid combination and also displayed the combo count between lower and upper range as well as total possible combo count. The resulting combo is listed starting column K, with each column having maximum of 1000000 combinations. if there's more results, they will continue in next columns

Sub Combinations()
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
Dim countCombo As Long, validCombo, ComboSum, lastRow As Long
Dim comboArr, blankCol, validCol As Variant


Range("I3").Value = Now


Application.ScreenUpdating = False


countCombo = 0
lastRow = 2
comboArr = Range("A1:F47").Value
blankCol = Range("XFA1:XFA1000001").Value
offsetCol = 0


lowerLimit = 5280.111
upperLimit = 5280.537
validCol = blankCol
validCombo = 0




For i = 1 To 32: For j = 1 To 40
For k = 1 To 47: For l = 1 To 44
For m = 1 To 38: For n = 1 To 34
  countCombo = countCombo + 1
  ComboSum = comboArr(i, 1) + comboArr(j, 2) + comboArr(k, 3) + comboArr(l, 4) + comboArr(m, 5) + comboArr(n, 6)
  If ComboSum <= upperLimit And ComboSum >= lowerLimit Then
    validCol(lastRow, 1) = comboArr(i, 1) & "," & comboArr(j, 2) & "," & comboArr(k, 3) & "," & comboArr(l, 4) & "," & comboArr(m, 5) & "," & comboArr(n, 6)
    lastRow = lastRow + 1
    validCombo = validCombo + 1
    If lastRow = 1000002 Then
      Range("K1:K1000001").Offset(0, offsetCol).Value = validCol
      validCol = blankCol
      lastRow = 2
      offsetCol = offsetCol + 1
    End If
  End If
Next: Next
Next: Next
Next: Next


Range("I1").Value = countCombo
Range("I2").Value = validCombo
Range("I4").Value = Now
Range("K1:K1000001").Offset(0, offsetCol).Value = validCol


Application.ScreenUpdating = True
End Sub