All combinations of k from n from different groups, whose sum is in a specific range

R

rocker3000

New Member
Joined
Oct 3, 2017
Messages
4
I'll make an example. I have three groups:
<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; white-space: inherit;">
A={1,2,3}
B={4,5}
C={6,7,8,9}
</code>
I need to find all possible combinations whose sum is between 16 and 20 by picking 2 elements from A, 1 element from B, and 1 elements from C. Each element will have a different letter to index it. For example:
<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; white-space: inherit;">
A={a,b,c}
B={d,e}
C={f,g,h,i}

</code>Then, a possible combination would be: abdh. This can be shown in separate cells or in a single cell.
It has to be done in Excel, preferably using array formulas but VBA is also fine.

I also need to be able to vary the number of groups, the elements and indexes in each group, how many elements to pick from each group, and the range in which the sums of the combinations have to lie in. So these variables should be inputs and/or I should be able to alter the formula/code to allow for any changes in these.
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Sort by date Sort by votes
Two sheets: One called "Problem" and one called "Solutions":


Book1
ABCD
1Lower Sum16
2Upper Sum20
3Group NameABC
4Elements From Group211
5Group Members146
6257
738
89
Problem


Code: 
Public Sub FindCombos()

Dim setSize As Long
Dim lastCol As Long
Dim thisCol As Long
Dim elCount As Long
Dim i As Long
Dim j As Long
Dim total As Long
Dim solution As String
Dim selectedCells() As Range
Dim rowStart() As Long
Dim setCount() As Long
Dim lastRow As Long
Dim nextRow As Long
Dim allOK As Boolean

' Clear out the solutions
Sheets("Solutions").Cells.ClearContents

' Find the last group and the number of elements we're going to pick
lastCol = Cells(3, Columns.Count).End(xlToLeft).Column
setSize = Application.WorksheetFunction.Sum(Range(Cells(4, 2), Cells(4, lastCol)))

' Set up the arrays
ReDim selectedCells(setSize) As Range
ReDim rowStart(lastCol) As Long
ReDim setCount(lastCol) As Long

' Set the initial selection
i = 1
Set selectedCells(0) = Cells(1, 1)
For thisCol = 2 To lastCol
    For elCount = 1 To Cells(4, thisCol).Value
        Set selectedCells(i) = Cells(4 + elCount, thisCol)
        i = i + 1
    Next elCount
Next thisCol

' Uniquely name each element in the groups
rowStart(2) = 97
For thisCol = 2 To lastCol
    lastRow = Cells(Rows.Count, thisCol).End(xlUp).Row
    setCount(thisCol) = lastRow - 4
    If thisCol < lastCol Then rowStart(thisCol + 1) = rowStart(thisCol) + setCount(thisCol)
Next thisCol

' Next solution row
nextRow = 1

' Keep going until we've exhausted all possibilities
Do While True
    ' Check the current total
    total = 0
    For i = 1 To setSize
        total = total + selectedCells(i).Value
    Next i
    
    ' Total is in range?
    If total >= Cells(1, 2).Value And total <= Cells(2, 2).Value Then
        ' Generate the solution
        solution = ""
        For i = 1 To setSize
            solution = solution & Chr$(rowStart(selectedCells(i).Column) + selectedCells(i).Row - 5)
        Next i
        
        ' Print the solution on the solution sheet
        Sheets("Solutions").Cells(nextRow, 1).Value = solution
        nextRow = nextRow + 1
    End If
    
    ' Tick over to the next selection
    i = setSize
    Do While True
        ' Move the cell down
        Set selectedCells(i) = selectedCells(i).Offset(1, 0)
        
        ' OK?
        If selectedCells(i).Value = "" Then
            ' Move this back to the top
            Set selectedCells(i) = Cells(5, selectedCells(i).Column)
            
            ' Move to the previous cell and move that
            i = i - 1
        Else
            allOK = True
            ' Adjust all other cells
            If i < setSize Then
                For j = i + 1 To setSize
                    If selectedCells(j).Column = selectedCells(i).Column Then
                        Set selectedCells(j) = selectedCells(j - 1).Offset(1, 0)
                        If selectedCells(j).Value = "" Then
                            i = i - 1
                            allOK = False
                            Exit For
                        End If
                    End If
                Next j
            End If
            
            ' Column exhausted
            If allOK Or i = 0 Then Exit Do
            
            ' Reset column?
            If selectedCells(i).Column <> selectedCells(i + 1).Column Then
                Set selectedCells(i + 1) = Cells(5, selectedCells(i + 1).Column)
                For j = i + 2 To setSize
                    If selectedCells(j).Column = selectedCells(j - 1).Column Then
                        Set selectedCells(j) = selectedCells(j - 1).Offset(1, 0)
                    End If
                Next j
            End If
        End If
        
        ' Done?
        If i = 0 Then Exit Do
    Loop
    
    ' Finished?
    If i = 0 Then Exit Do
Loop

End Sub


Book1
A
1abdi
2abeh
3abei
4acdh
5acdi
6aceg
7aceh
8acei
9bcdg
10bcdh
11bcdi
12bcef
13bceg
14bceh
15bcei
Solutions


WBD
 
Upvote 0
Great solution. Thanks!

If I wanted to have different indexes for each group? Say:

A={a,b,c}
B={1,2}
C={A,B,C,D}

So a solution could be ab2C.
 
Upvote 0

Book1
ABCD
1Lower Sum16
2Upper Sum20
3Group Start Charactera1A
4Elements From Group211
5Group Members146
6257
738
89
Problem


Code: 
Public Sub FindCombos()

Dim setSize As Long
Dim lastCol As Long
Dim thisCol As Long
Dim elCount As Long
Dim i As Long
Dim j As Long
Dim total As Long
Dim solution As String
Dim selectedCells() As Range
Dim rowStart() As Long
Dim setCount() As Long
Dim lastRow As Long
Dim nextRow As Long
Dim allOK As Boolean

' Clear out the solutions
Sheets("Solutions").Cells.ClearContents

' Find the last group and the number of elements we're going to pick
lastCol = Cells(3, Columns.Count).End(xlToLeft).Column
setSize = Application.WorksheetFunction.Sum(Range(Cells(4, 2), Cells(4, lastCol)))

' Set up the arrays
ReDim selectedCells(setSize) As Range
ReDim rowStart(lastCol) As Long
ReDim setCount(lastCol) As Long

' Set the initial selection
i = 1
Set selectedCells(0) = Cells(1, 1)
For thisCol = 2 To lastCol
    For elCount = 1 To Cells(4, thisCol).Value
        Set selectedCells(i) = Cells(4 + elCount, thisCol)
        i = i + 1
    Next elCount
Next thisCol

' Uniquely name each element in the groups
For thisCol = 2 To lastCol
    lastRow = Cells(Rows.Count, thisCol).End(xlUp).Row
    setCount(thisCol) = lastRow - 4
    rowStart(thisCol) = Asc(Cells(3, thisCol))
Next thisCol

' Next solution row
nextRow = 1

' Keep going until we've exhausted all possibilities
Do While True
    ' Check the current total
    total = 0
    For i = 1 To setSize
        total = total + selectedCells(i).Value
    Next i
    
    ' Total is in range?
    If total >= Cells(1, 2).Value And total <= Cells(2, 2).Value Then
        ' Generate the solution
        solution = ""
        For i = 1 To setSize
            solution = solution & Chr$(rowStart(selectedCells(i).Column) + selectedCells(i).Row - 5)
        Next i
        
        ' Print the solution on the solution sheet
        Sheets("Solutions").Cells(nextRow, 1).Value = solution
        nextRow = nextRow + 1
    End If
    
    ' Tick over to the next selection
    i = setSize
    Do While True
        ' Move the cell down
        Set selectedCells(i) = selectedCells(i).Offset(1, 0)
        
        ' OK?
        If selectedCells(i).Value = "" Then
            ' Move this back to the top
            Set selectedCells(i) = Cells(5, selectedCells(i).Column)
            
            ' Move to the previous cell and move that
            i = i - 1
        Else
            allOK = True
            ' Adjust all other cells
            If i < setSize Then
                For j = i + 1 To setSize
                    If selectedCells(j).Column = selectedCells(i).Column Then
                        Set selectedCells(j) = selectedCells(j - 1).Offset(1, 0)
                        If selectedCells(j).Value = "" Then
                            i = i - 1
                            allOK = False
                            Exit For
                        End If
                    End If
                Next j
            End If
            
            ' Column exhausted
            If allOK Or i = 0 Then Exit Do
            
            ' Reset column?
            If selectedCells(i).Column <> selectedCells(i + 1).Column Then
                Set selectedCells(i + 1) = Cells(5, selectedCells(i + 1).Column)
                For j = i + 2 To setSize
                    If selectedCells(j).Column = selectedCells(j - 1).Column Then
                        Set selectedCells(j) = selectedCells(j - 1).Offset(1, 0)
                    End If
                Next j
            End If
        End If
        
        ' Done?
        If i = 0 Then Exit Do
    Loop
    
    ' Finished?
    If i = 0 Then Exit Do
Loop

End Sub

Changed row 3 to indicate the first character of the group.

WBD
 
Upvote 0
Hello WBD, I open thread yesterday under this link </SPAN></SPAN>
https://www.mrexcel.com/forum/excel...ery-combinations-post5361432.html#post5361432</SPAN></SPAN>
Later searching in the site Goggle and in the MrExcel forums I come across to your thread I guess post#2 is a solution of my request. But I need numbers to be real and result must be split in the 5 columns instead alphabetical result in the one column.</SPAN></SPAN>

Does is it possible? Please can you take a look? </SPAN></SPAN>

Thank you</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Moti</SPAN></SPAN>
 
Last edited:
Upvote 0
motilulla said:
Hello WBD, I open thread yesterday under this link </SPAN></SPAN>
https://www.mrexcel.com/forum/excel...ery-combinations-post5361432.html#post5361432</SPAN></SPAN>
Later searching in the site Goggle and in the MrExcel forums I come across to your thread I guess post#2 is a solution of my request. But I need numbers to be real and result must be split in the 5 columns instead alphabetical result in the one column.</SPAN></SPAN>

Does is it possible? Please can you take a look? </SPAN></SPAN>

Thank you</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Moti</SPAN></SPAN>
Click to expand...
Any idea Please?
 
Upvote 0
You must log in or register to reply here.

Similar threads

rediffusion
  • Question Question
How can i add button to `ContextMenuShape`?
Replies
0
Views
1K
rediffusion
rediffusion
A
  • Question Question
Conditional formatting is not working for less than TODAY(), only for greater than
Replies
2
Views
1K
alexpazolini
A
H
  • Question Question
Compare two week numbers from different years in Excel
Replies
2
Views
2K
Tetra201
Tetra201
J
  • Question Question
Extract href link from source code using VBA
Replies
3
Views
15K
Domenic
D
A
  • Question Question
At a same time refresh all data connections in all open workbooks
Replies
0
Views
2K
adpatel
A

Forum statistics

Threads
1,223,894
Messages
6,175,254
Members
452,624
Latest member
gregg777

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top