Add & calculate Values in Scripting.Dictionary

Dear Mike,
Sorry for delyed reply but you are simply great...

With the help of your codes the results are coming in very less time.

I have further reduced the entries in array by restricting via IF condition.
Just one more help is required. When I run the program for below mentioned sizes the I am getting error - "Out of memory (Error 7)" might be due to the combinations are coming to some 1,331,000 no.s which array is not able to handle.

I have tried to define array as Long or Double not get success.

Main Size Size1 Size2 Size3 Size4 Size5 Size6 Size7
1020 100 101 102 103 104 105 106

Please suggest if there is any solution.

Sub MinCombo()
Dim i1, i2, i3, i4, i5, i6, i7, j, k, x, y, z, tt As Long
Dim arr(), Fix_Value, Main_Size, A_Cal

Main_Size = Range("A2").Value
Fix_Value = Range("J1").Value
A_Cal = Range("L1").Value

If (Range("B2") > 0) Then i1 = Application.WorksheetFunction.RoundDown(Range("A2") / Range("B2"), 0)
If (Range("C2") > 0) Then i2 = Application.WorksheetFunction.RoundDown(Range("A2") / Range("C2"), 0)
If (Range("D2") > 0) Then i3 = Application.WorksheetFunction.RoundDown(Range("A2") / Range("D2"), 0)
If (Range("E2") > 0) Then i4 = Application.WorksheetFunction.RoundDown(Range("A2") / Range("E2"), 0)
If (Range("F2") > 0) Then i5 = Application.WorksheetFunction.RoundDown(Range("A2") / Range("F2"), 0)
If (Range("G2") > 0) Then i6 = Application.WorksheetFunction.RoundDown(Range("A2") / Range("G2"), 0)
If (Range("H2") > 0) Then i7 = Application.WorksheetFunction.RoundDown(Range("A2") / Range("H2"), 0)

tt = (i1 + 1) * (i2 + 1) * (i3 + 1) * (i4 + 1) * (i5 + 1) * (i6 + 1) * (i7 + 1)

response = MsgBox("No. of combinations are => " & tt, vbOK)
If response = vbCancel Then
    MsgBox ("Macro Ending")
    Exit Sub
End If

Range("A3:Z65536").Select
    Selection.ClearContents
Range("B2").Select
ii = 0
ReDim arr(1 To tt, 1 To 16)
For x1 = 0 To i1
    For x2 = 0 To i2
        For x3 = 0 To i3
            For x4 = 0 To i4
                For x5 = 0 To i5
                    For x6 = 0 To i6
                        For x7 = 0 To i7
                            ii = Main_Size - Cells(2, "b") * x1 - Cells(2, "c") * x2 - Cells(2, "d") * x3 - Cells(2, "e") * x4 - Cells(2, "f") * x5 - Cells(2, "g") * x6 - Cells(2, "h") * x7
                            If ii >= 0 And ii <= A_Cal Then
                            i = i + 1
                            arr(i, 1) = x1
                            arr(i, 2) = x2
                            arr(i, 3) = x3
                            arr(i, 4) = x4
                            arr(i, 5) = x5
                            arr(i, 6) = x6
                            arr(i, 7) = x7
                            arr(i, 8) = Main_Size - Cells(2, "b") * x1 - Cells(2, "c") * x2 - Cells(2, "d") * x3 - Cells(2, "e") * x4 - Cells(2, "f") * x5 - Cells(2, "g") * x6 - Cells(2, "h") * x7
                            arr(i, 9) = Round(x1 * Cells(2, "b") * Cells(1, "j") / Cells(2, "a"), 2)
                            arr(i, 10) = Round(x2 * Cells(2, "c") * Cells(1, "j") / Cells(2, "a"), 2)
                            arr(i, 11) = Round(x3 * Cells(2, "d") * Cells(1, "j") / Cells(2, "a"), 2)
                            arr(i, 12) = Round(x4 * Cells(2, "e") * Cells(1, "j") / Cells(2, "a"), 2)
                            arr(i, 13) = Round(x5 * Cells(2, "f") * Cells(1, "j") / Cells(2, "a"), 2)
                            arr(i, 14) = Round(x6 * Cells(2, "g") * Cells(1, "j") / Cells(2, "a"), 2)
                            arr(i, 15) = Round(x7 * Cells(2, "h") * Cells(1, "j") / Cells(2, "a"), 2)
                            arr(i, 16) = Round(Fix_Value - WorksheetFunction.Sum(arr(i, 9), arr(i, 10), arr(i, 11), arr(i, 12), arr(i, 13), arr(i, 14), arr(i, 15)), 2)
                            End If
                        Next
                    Next
                Next
            Next
        Next
    Next
Next

response = MsgBox("No. of rows filled will be => " & i, vbOK)
If response = vbCancel Then
    MsgBox ("Macro Ending")
    Exit Sub
End If

    Range("b3:r" & i) = arr
'Range("b3").Resize(UBound(arr, 1), UBound(arr, 2)) = arr

End Sub