Ordering Exercise

[tiredofit]

This is my data:

and these are the results:

931
935
934
936
915
914
916
954
956
3154
3156
3156
3546
1546

 

[tiredofit]

Why is 931546 invalid?

Since 931 ie 30+20+15 already meets the target (>50%) of 100), we don't need to add any more digits to that combination.

 

[Cubist]

Why is 5,4,9 invalid? 5,4 is the last largest pair.

 

[tiredofit]

Why is 5,4,9 invalid? 5,4 is the last largest pair.

The order of the digits does not matter, so 5,4,9 has been already "represented" by 9,5,4.

 

[Cubist]

1,5,4,6 is equal to 50. Should be excluded. Try:

loop50.xlsm
	A	B	C
1	9	30	9,3,1
2	3	20	9,3,5
3	1	15	9,3,4
4	5	15	9,3,6
5	4	10	9,1,5
6	6	10	9,1,4
7	2		9,1,6
8	7		9,5,4
9	8		9,5,6
10	10		3,1,5,4
11			3,1,5,6
12			3,1,4,6
13			3,5,4,6
Sheet1

Sub FindSumCombinations()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change sheet name if needed
    
    Dim colA As Range
    Dim colB As Range
    Dim lastRow As Long
    Dim i As Long, j As Long, k As Long, l As Long
    Dim sum As Long
    Dim threshhold As Double
    Dim results As Collection
    
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Set colA = ws.Range("A1:A" & lastRow)
    Set colB = ws.Range("B1:B" & lastRow)
    Set results = New Collection
    threshold = 50
    
    For i = 1 To lastRow - 1
        For j = i + 1 To lastRow
            sum = colB(i).Value + colB(j).Value
            If sum > threshold Then
                results.Add colA(i).Value & "," & colA(j).Value
            Else
                For k = j + 1 To lastRow
                    sum = colB(i).Value + colB(j).Value + colB(k).Value
                    If sum > threshold Then
                        results.Add colA(i).Value & "," & colA(j).Value & "," & colA(k).Value
                    Else
                        For l = k + 1 To lastRow
                            sum = colB(i).Value + colB(j).Value + colB(k).Value + colB(l).Value
                            If sum > threshold Then
                                results.Add colA(i).Value & "," & colA(j).Value & "," & colA(k).Value & "," & colA(l).Value
                            End If
                        Next l
                    End If
                Next k
            End If
        Next j
    Next i
    
    ' Output results
    Dim outputRow As Long
    outputRow = 1
    For Each result In results
        ws.Cells(outputRow, "C").Value = result
        outputRow = outputRow + 1
    Next result
End Sub

 

[tiredofit]

1,5,4,6 is equal to 50. Should be excluded. Try:

loop50.xlsm
	A	B	C
1	9	30	9,3,1
2	3	20	9,3,5
3	1	15	9,3,4
4	5	15	9,3,6
5	4	10	9,1,5
6	6	10	9,1,4
7	2		9,1,6
8	7		9,5,4
9	8		9,5,6
10	10		3,1,5,4
11			3,1,5,6
12			3,1,4,6
13			3,5,4,6
Sheet1

Sub FindSumCombinations()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change sheet name if needed
   
    Dim colA As Range
    Dim colB As Range
    Dim lastRow As Long
    Dim i As Long, j As Long, k As Long, l As Long
    Dim sum As Long
    Dim threshhold As Double
    Dim results As Collection
   
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Set colA = ws.Range("A1:A" & lastRow)
    Set colB = ws.Range("B1:B" & lastRow)
    Set results = New Collection
    threshold = 50
   
    For i = 1 To lastRow - 1
        For j = i + 1 To lastRow
            sum = colB(i).Value + colB(j).Value
            If sum > threshold Then
                results.Add colA(i).Value & "," & colA(j).Value
            Else
                For k = j + 1 To lastRow
                    sum = colB(i).Value + colB(j).Value + colB(k).Value
                    If sum > threshold Then
                        results.Add colA(i).Value & "," & colA(j).Value & "," & colA(k).Value
                    Else
                        For l = k + 1 To lastRow
                            sum = colB(i).Value + colB(j).Value + colB(k).Value + colB(l).Value
                            If sum > threshold Then
                                results.Add colA(i).Value & "," & colA(j).Value & "," & colA(k).Value & "," & colA(l).Value
                            End If
                        Next l
                    End If
                Next k
            End If
        Next j
    Next i
   
    ' Output results
    Dim outputRow As Long
    outputRow = 1
    For Each result In results
        ws.Cells(outputRow, "C").Value = result
        outputRow = outputRow + 1
    Next result
End Sub

I've tested your code and it works as expected.

Apologies for the mistake 43 1,5,4,6 (and you prob as spotted 3,1,5,6 was typed twice).

It took me A VERY LONG time just to formulate an easier structure (sorting from larhgest to smallest).

Many thanks for your help over the last few days.