Only give 100 solutions

[Legacy 287389]

Hi good people!,
This is my code:

Sub AllSolutions()
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim l As Integer
    Dim m As Integer
            
    Dim i1 As Integer
    Dim j1 As Integer
    Dim k1 As Integer
    Dim l1 As Integer
    Dim m1 As Integer
        
    Dim iH As Integer
    Dim iL As Integer
        
    Dim lRow As Long
    Dim Sh1 As Worksheet
    Dim Sh2 As Worksheet
    
    Set Sh1 = Worksheets("Sheet1")
    Set Sh2 = Worksheets("Solutions")
    On Error Resume Next
    Application.DisplayAlerts = False
    On Error GoTo 0
    
    iH = Sh1.Range("A3").Value
    iL = Sh1.Range("A3").Value / Sh1.Range("B3").Value
    
   [I] i1 = Sh1.Range("D2").Value
    j1 = Sh1.Range("E2").Value
    k1 = Sh1.Range("F2").Value
    l1 = Sh1.Range("G2").Value
    m1 = Sh1.Range("H2").Value[/I]       
    lRow = 1
    
    For i = i1 To iH Step i1
     For j = j1 To iH - i Step j1
      For k = k1 To iH - i - j Step k1
       For l = l1 To iH - i - j - k Step l1
        m = iH - i - j - k - l
         If m Mod m1 = 0 Then 'Changed
         If i / i1 + j / j1 + k / k1 + l / l1 + m / m1 = iL Then 'Changed
                        lRow = lRow + 1
                        With Sh2
                            .Cells(lRow, "A") = i
                            .Cells(lRow, "B") = j
                            .Cells(lRow, "C") = k
                            .Cells(lRow, "D") = l
                            .Cells(lRow, "E") = m
                            End With
                        If lRow = 100001 Then
                        MsgBox "Limit of 100 000 solutions calculated"
                            Worksheets("Solutions").Select
                            Exit Sub
                        End If
                       End If
                      End If
                     Next l
                    Next k
                  Next j
                 Next i
Application.ScreenUpdating = False
Worksheets("Solutions").Select
    Range("F2").Select
    Application.Goto Reference:="R2C6:R100001C6"
    Selection.FillDown
    Range("G2").Select
    Application.Goto Reference:="R2C7:R100001C7"
    Selection.FillDown
    Range("H2").Select
    Application.Goto Reference:="R2C8:R100001C8"
    Selection.FillDown
    Range("I2").Select
    Application.Goto Reference:="R2C9:R100001C9"
    Selection.FillDown
    Range("J2").Select
    Application.Goto Reference:="R2C10:R100001C10"
    Selection.FillDown
    Range("A1").Select
 Worksheets("Sheet1").Select
 MsgBox "All Possible Relationships Had Been Calculated"
End Sub

If you focus on the Italic piece of the code, you will notice that I have values from D2 to H2. Just to clarify quickly, what this code does is it gives all possible combinations which, when summed, gives the total value iH. These values have a relationship with the values in D2 to H2. These values are also plotted on the "Solution sheet" columns A to E. Okay, the problem is that the answers start with the value i1. i1 is repeated until all combinations have been calculated. As soon as all possible relationships (combinations) had been calculated, column A steps the original value by i1, and again calculates the possible combinations. The change I would like to have, is to only calculate 100 combinations for each i1 value. Currently I am getting between 40 000 and 50 000 combs for just one i1 value.
I hope this makes sense. if anyone can help, please..I will be forever very very grateful. Thanx people!

 

[WaterGypsy]

You already have a counter to limit the process to 100,000 lines.... I think you need another counter that you add to each time you output something .. but this is to be reset to zero every time you enter the loop at "For i = i1 to iH ....", then you need to exit from the loops (For J...; For k....; For L...) if this new counter exceeds 100

 

[Legacy 287389]

Thanx for that..okay, I have tried writing the syntax to check the count. I just don't get that part right. basically I'm looking for the syntax if I want the code to : IF the COUNTIF in COLUMN A with value i1 is EQUAL to 100, it must then carry on with the next i1. If you do not mind, how is that vba syntax written?. I will play then with it and see where it must be fit in etc...

 

[WaterGypsy]

After "For i = i1 To iH Step i1" insert "iNewLimit = 0"

after "lRow = lRow + 1" insert "iNewLimit = iNewLimit + 1"

before the lines that say "Next L", "Next K", "Next J" insert "If iNewLimit >= 100 then exit for"

 

[Legacy 287389]

Thanx so much. I have run out of time here, will implement on Monday and give feedback. Hope it will be okay with you. Again, a BIG Thank you.

 

[Legacy 287389]

I have included the above, and get an error "variable not defined". Vba highlites "iNewLimit". I have tried to correct this by inserting "Dim iNewLimit As Variant"...but alas, does not seem to be working because now I get "End If without Block If". I so wish I could understand all these things..

 

[WaterGypsy]

Sorry ... Add "End If" after each "Exit For"

 

[Legacy 287389]

No problem,

I am getting side tracked a lot so I am not spending as much time as I want to with this. I am going to run the code just before I go home, will then see tomorrow morning what the results are. I do apologize about this, please forgive me if this is not the way you do things. Will let you know then. In the meantime, thank you again..

 

[Legacy 287389]

Good Morning WaterGypsy, The code is working beautifully. I really do appreciate your time spent on this and your patience. Have a wonderful day..

 

[Legacy 287389]

Hi WaterGypsy, I realize this thread has been dealt with, but please, if you don't mind...would you kindly be able to show me how to have the code carry on populating the next sheet if sheet 1 is filled to maybe 1000 000 lines?..If you would, I would be really forever grateful.