```
Sub CombinationsWOReplacement()
Dim inputRng As Range, outputRng As Range, oCell As Range
Dim Count1 As Long, Counter As Long, i As Long, j As Long, k As Long, m As Long, n As Long, s As String
Dim readInCounter As Long: readInCounter = 0
Dim readInArray() As Variant
Dim allComs() As Variant
Dim subsetComs() As Variant
Dim flag As Boolean, flag2 As Boolean
Set inputRng = Application.InputBox(Prompt:="Select the input numbers", Default:=ActiveCell, Type:=8)
Set outputRng = Application.InputBox(Prompt:="Select one cell where you want the display to start", Default:=ActiveCell, Type:=8)
Dim lowBound As Integer: lowBound = Application.InputBox(Prompt:="Enter the lower bound number for the output", Default:=26, Type:=1)
Dim upperBound As Integer: upperBound = Application.InputBox(Prompt:="Enter the upper bound number for the output", Default:=30, Type:=1)
Application.ScreenUpdating = False
Application.EnableEvents = False
Count1 = inputRng.Cells.Count
ReDim readInArray(1 To Count1, 0 To 1) As Variant
ReDim allComs(1 To 2 ^ Count1 - 1, 0 To 1) As Variant
For Each oCell In inputRng.Cells
readInCounter = readInCounter + 1
readInArray(readInCounter, 0) = oCell.Value
readInArray(readInCounter, 1) = "Available"
Next oCell
m = 1
For i = 1 To Count1
k = 0
For j = 1 To i
k = k + 2 ^ (j - 1)
Next j
For n = m To k
If n = k Then
allComs(n, 0) = readInArray(i, 0)
allComs(n, 1) = CStr(readInArray(i, 0))
Else
allComs(n, 0) = allComs(n - m + 1, 0) + readInArray(i, 0)
allComs(n, 1) = allComs(n - m + 1, 1) & "," & CStr(readInArray(i, 0))
End If
Next n
m = k + 1
Next i
m = 0
For i = 1 To UBound(allComs, 1)
If allComs(i, 0) >= lowBound And allComs(i, 0) <= upperBound Then
m = m + 1
ReDim Preserve subsetComs(0 To 1, 1 To m) As Variant
subsetComs(0, m) = allComs(i, 0)
subsetComs(1, m) = allComs(i, 1)
End If
Next i
m = 0
For n = upperBound To lowBound Step -1
For i = 1 To UBound(subsetComs, 2)
Application.StatusBar = Format((upperBound - n) / (upperBound - lowBound + 1) + i / UBound(subsetComs, 2) / (upperBound - lowBound + 1), "0.0%") & " Complete"
s = ""
flag2 = True
For j = 1 To Len(subsetComs(1, i))
If Mid(subsetComs(1, i), j, 1) = "," Or j = Len(subsetComs(1, i)) Then
If j = Len(subsetComs(1, i)) Then s = s & Mid(subsetComs(1, i), j, 1)
flag = False
For k = 1 To UBound(readInArray, 1)
If readInArray(k, 0) = CDbl(s) And readInArray(k, 1) = "Available" Then
readInArray(k, 1) = "Maybe"
flag = True
Exit For
End If
Next k
s = ""
If Not flag Then flag2 = False
Else
s = s & Mid(subsetComs(1, i), j, 1)
End If
Next j
If flag2 Then
For k = 1 To UBound(readInArray, 1)
If readInArray(k, 1) = "Maybe" Then readInArray(k, 1) = "Used"
Next k
outputRng.Offset(m, 0) = subsetComs(1, i)
m = m + 1
Else
For k = 1 To UBound(readInArray, 1)
If readInArray(k, 1) = "Maybe" Then readInArray(k, 1) = "Available"
Next k
End If
Next i
Next n
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
```