Second Loop in Macro

[JLouis]

Hello again!

I have this code below, already enhanced by you good folks, but now I have another question.

This code returns all the possiblities of a variety of numbers that match the total in cell G2, OriginalVal, in this case 600. I've also used it to match the same numbers for G2-10 and so forth. I'm running 5 different macros to get the set of numbers between 550 and 600. I know there's a better way.

I'd like to have one macro to return all the possiblities in the set of numbers that match the total between 550 and 600. I would guess I need another loop that runs on top of the current one that either loops on the G2, G2-10, G2-20 and so on or uses the summ variable in the macro to accomplish the same thing.

I've tried adding the loop without success and would appreciate you good folks taking a look to see what can be done. Thanks for looking.

Sub NewSum600()

ActiveSheet.Unprotect
Application.ScreenUpdating = False
ActiveSheet.Shapes("600 1").Visible = False
Dim Num1 As Long, Num2 As Long, Num3 As Long, summ As Long, Num4 As Long
Dim ForCnt1 As Integer, ForCnt2 As Integer, ForCnt3 As Integer, ForCnt4 As Integer
Dim ColNum As Integer
Dim OriginalVal As Long, LoopCnt As Long


ActiveSheet.Range("g2").Select

LoopCnt = Sheets("CalcMe").Range("b1").Value

ColNum = 3

OriginalVal = Sheets("CalcMe").Range("C2").Value

For ForCnt1 = 2 To LoopCnt
    Num1 = Sheets("CalcMe").Range("B" & ForCnt1).Value

    For ForCnt2 = ForCnt1 + 1 To LoopCnt
    Num2 = Sheets("CalcMe").Range("B" & ForCnt2).Value
   
        For ForCnt3 = ForCnt2 + 1 To LoopCnt
        Num3 = Sheets("CalcMe").Range("B" & ForCnt3).Value
           
        For ForCnt4 = ForCnt3 + 1 To LoopCnt
        Num4 = Sheets("CalcMe").Range("B" & ForCnt4).Value
       
              summ = Num1 + Num2 + Num3 + Num4

                        If summ = OriginalVal Then
                            ActiveSheet.Range("g65536").End(xlUp).Offset(1, 0).Select
                            ActiveCell = Sheets("CalcMe").Range("B" & ForCnt1).Offset(0, -1).Value
                            ActiveCell.Offset(0, 1).Select
                            ActiveCell = Sheets("CalcMe").Range("B" & ForCnt2).Offset(0, -1).Value
                            ActiveCell.Offset(0, 1).Select
                            ActiveCell = Sheets("CalcMe").Range("B" & ForCnt3).Offset(0, -1).Value
                            ActiveCell.Offset(0, 1).Select
                              ActiveCell = Sheets("CalcMe").Range("B" & ForCnt4).Offset(0, -1).Value
                        End If
           Next ForCnt4
        Next ForCnt3
    Next ForCnt2
Next ForCnt1

End Sub

 

[Anthony47]

As a first approach I should suggest using

If Abs(summ - OriginalVal) < Tolerance Then

This needs you had set Tolerance = 25 and OriginalVal = 575

Also I wonder whether it is correct using For ForCnt1 = 2 To LoopCnt and not For ForCnt1 = 2 To LoopCnt - 3 (and similarly -2 / -1 for ForCnt2 and ForCnt3)

If you need to recover some cpu time consider that "Selection" is not needed to populate the output; so this loop could replace your:

                        If Abs(summ - OriginalVal) < Tolerance Then
                            NextR = ActiveSheet.Range("g65536").End(xlUp).Offset(1, 0).Row
                            Cells(NextR, "G") = Sheets("CalcMe").Range("B" & ForCnt1).Offset(0, -1).Value
                            Cells(NextR, "H") = Sheets("CalcMe").Range("B" & ForCnt2).Offset(0, -1).Value
                            Cells(NextR, "I") = Sheets("CalcMe").Range("B" & ForCnt3).Offset(0, -1).Value
                            Cells(NextR, "J") = Sheets("CalcMe").Range("B" & ForCnt4).Offset(0, -1).Value
                        End If

(and why col G, H, I, and J are not simply equal to Num1, Num2, Num3 and Num4?)

 

[JLouis]

Interesting. So the use of tolerance encaspulates whatever range I want to set instead of a hard fast fixed value. I'll see how I can bring this into my macro. Do I declare tolerance as an integer?

Thanks for that. If I get that to work as desired I'll come back and mark as solved.

 

[Anthony47]

Declare Tolerance as Long, as SUMM and OriginalValue are both Long

It would probably be wise that you store in column K the value of "summ":

                            Cells(NextR, "k") = summ

 

[JLouis]

Excellent. Thank you.