Sub test()

Dim RNG As Range
Dim tempVal&, iMax&, iMin&
Dim MeArr(), tempArr(), ResultArr()
Dim StrTransfer$
Dim i&, j&, x&, y&

    iMax = [G3]
    iMin = [F3]
    Set RNG = Application.InputBox(Prompt:="Выберите дапазон", Title:="", Type:=8)
    tempArr = Application.Transpose(RNG.Value)

    For i = LBound(tempArr) To UBound(tempArr) 'сортируем полученный массив от меньшего к большему
        x = tempArr(i)
        For j = i To UBound(tempArr)
            If tempArr(j) < x Then
                x = tempArr(j): y = tempArr(i)
                tempArr(i) = x: tempArr(j) = y
            End If
        Next j
    Next i
    MeArr = tempArr

    i = 1
    ReDim tempArr(1 To 20, 1 To i)
    Do  'цикл для поиска групп
        j = 1
        tempVal = Val(MeArr(UBound(MeArr))): MeArr(UBound(MeArr)) = "--" 'затираю черточками, что бы потом исключить из массива использованное число
        If tempVal > 120 Then GoTo Propuskaem   'если входное число больше максимально-допустимого, то переходим к следующему

        tempArr(j, i) = tempVal
        For x = LBound(MeArr) To UBound(MeArr) - 1
            If (tempVal + Val(MeArr(x))) = iMax Then
                j = j + 1
                tempArr(j, i) = Val(MeArr(x)): MeArr(x) = "--"
                tempVal = tempVal + tempArr(j, i)
                Exit For

            ElseIf (tempVal + Val(MeArr(x))) > iMax Then
                If tempArr(j, i) = 0 Or x = 1 Then Exit For
                j = j + 1
                tempArr(j, i) = Val(MeArr(x - 1)): MeArr(x - 1) = "--"
                tempVal = tempVal + tempArr(j, i)
                x = LBound(MeArr) - 1

            ElseIf x = UBound(MeArr) - 1 Then       'если дошли до конца массива, а первые два условия не выполнились, то
                For y = x To LBound(MeArr) Step -1  'перебираем массив в обратном порядке и собираем числа с конца массива.
                    If Val(MeArr(y)) > 0 Then Exit For
                Next y
                j = j + 1
                tempArr(j, i) = Val(MeArr(y)): MeArr(y) = "--"
                tempVal = tempVal + tempArr(j, i)
                x = LBound(MeArr) - 1

            ElseIf Val(MeArr(1)) = 0 And (tempVal + Val(MeArr(2))) > iMax Then   '
                Exit For
            End If
        Next x
        If tempVal < iMin Then Exit Do 'если в результат попало число меньше минимального, то пора выходить из цикла
        i = i + 1
        ReDim Preserve tempArr(1 To 20, 1 To i) 'увеличиваем размер массива для сбора результатов

Propuskaem:
' следующие две строки переопределяют размер масива исключая использованные числа
        StrTransfer = Replace(Replace(Join(MeArr, "|"), "|--", ""), "--|", "")
        MeArr = Application.Transpose(Application.Transpose(Split(StrTransfer, "|")))
    Loop
'выводим полученный результат
    x = i - 1
    ReDim ResultArr(1 To x)
    For i = 1 To x
        For j = 1 To 20
            If tempArr(j, i) > 0 Then ResultArr(i) = IIf(j = 1, "", ResultArr(i) & "+") & tempArr(j, i) Else Exit For
        Next j
    Next i

    Cells(2, 9).Resize(UBound(ResultArr)) = Application.Transpose(ResultArr)

'выодим "хвосты" в отдельный столбец
    For j = 1 To 20
        If tempArr(j, i) > 0 Then Cells(1 + j, 8) = tempArr(j, i) Else Exit For
    Next j

End Sub

If tempVal > 120 Then GoTo Propuskaem

If tempVal > iMax Then GoTo Propuskaem