I basically have two sheets.
The first sheet holds the data to be used.
Cell "D3" is the number to be used for the "SubSet". The SubSet is holding the correct figure in the Macro.
Cells "D4:52" holds the numbers to be used, but out of these 49 cells, there could be 7 numbers, 12 numbers or whatever.
The second sheet is where the results are to be output.
I have tried several different things but to no avail.
My findings so far:-
The "SubSet" is holding the correct figure.
The "TotalSpecified" is holding 49 I think instead of how many numbers are actually in cells "D4:52" because there are 49 cells, albeit most of them blank. So it is doing the calculation Combin(49, SubSet) instead of Combin(TotalSpecified, SubSet). I have tried several different approaches to resolve this, some of which are shown by the commented out lines at the top of the Macro.
The "NumOfComb" is showing the Combin(TotalSpecified, SubSet) because of what I said above.
The "NewComb", "CountOff", "Counter1" & "Counter2", well I have no idea where the figures they are holding come from.
Here is the code:-
[vba]Option Explicit
Sub Combinations_From_A_Range()
Dim Counter1 As Long
Dim Counter2 As Long
Dim CountOff()
Dim DrawnFrom As Long
Dim Dummy
Dim MaxOff()
Dim myWrap As Long
Dim NewComb As String
Dim NumOfComb As Long
Dim SepChar As String
Dim SpecificNumbers As Variant
Dim SubSet As Long
Dim TotalSpecified As Long
myWrap = 1000000 ' Select How Many Combinations for EACH Column.
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
With Sheets("Numbers In Selection").Select
SubSet = Range("D3").Value ' The SubSet is the Total Numbers Drawn.
SpecificNumbers = Range("D452").Value
With Sheets("Results").Select
Cells.EntireColumn.Delete
Range("A1").Select
SepChar = "-" ' The Character Used to Separate the Numbers ( These Work , ; - = ).
TotalSpecified = UBound(SpecificNumbers)
NumOfComb = Application.Combin(TotalSpecified, SubSet)
ReDim CountOff(SubSet)
ReDim MaxOff(SubSet)
For Counter1 = 1 To SubSet
CountOff(Counter1) = Counter1
MaxOff(Counter1) = DrawnFrom - SubSet + Counter1
Next Counter1
For Counter1 = 1 To NumOfComb
NewComb = ""
For Counter2 = 1 To SubSet
NewComb = NewComb & Application.WorksheetFunction.Text(CountOff(Counter2), "00") _
& SepChar
Next Counter2
ActiveCell.Offset(((Counter1 - 1) Mod myWrap), Int((Counter1 - 1) / myWrap)) = _
Left(NewComb, Len(NewComb) - Len(SepChar))
CountOff(SubSet) = CountOff(SubSet) + 1
Dummy = SubSet
While Dummy > 1
If CountOff(Dummy) > MaxOff(Dummy) Then
CountOff(Dummy - 1) = CountOff(Dummy - 1) + 1
For Counter2 = Dummy To SubSet
CountOff(Counter2) = CountOff(Counter2 - 1) + 1
Next Counter2
End If
Dummy = Dummy - 1
Wend
Next Counter1
Cells.EntireColumn.AutoFit: Cells.EntireColumn.HorizontalAlignment = xlCenter
End With
End With
With Application
.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End Sub[/vba]
Any help will be greatly appreciated.
I have adapted the code at the top to incorporate a loop, but unfortunately the Macro still doesn't work. However, although it is not actually picking up the correct numbers, it does output ONLY the total combinations for Combin(the max number in cells "D452", 6), albeit the wrong combinations.
Here is the revised code:-
[vba]Option Explicit
Sub Combinations_From_A_Range()
Dim Counter1 As Long
Dim Counter2 As Long
Dim CountOff()
Dim DrawnFrom As Long
Dim Dummy
Dim MaxOff()
Dim myWrap As Long
Dim NewComb As String
Dim NumOfComb As Long
Dim SepChar As String
Dim SpecificNumbers As Variant
Dim SubSet As Long
Dim TotalSpecified As Long
myWrap = 1000000 ' Select How Many Combinations for EACH Column.
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
With Sheets("Numbers In Selection").Select
SubSet = Range("D3").Value ' The SubSet is the Total Numbers Drawn.
' Find all the combinations of six integer numbers, each in the range 1..49,
' that sum to the value of a desired total. A combination may not have two
' numbers that are the same. Results are written to columns A..F of the
' active worksheet.
Dim Total As Integer
Dim N1 As Integer
Dim N2 As Integer, Sum2 As Integer
Dim N3 As Integer, Sum3 As Integer
Dim N4 As Integer, Sum4 As Integer
Dim N5 As Integer, Sum5 As Integer
Dim N6 As Integer
Dim iRow As Long
'Total = CInt(InputBox("Enter desired total", "Combos", 60))
'If Total = 0 Then Exit Sub
Cells.Clear
'Modified to find all combinations by total of 6 numbers
Application.ScreenUpdating = False
For Total = 21 To 279
col = col + 1
Cells(1, col) = Total
iRow = 2
'Original code
For N6 = (Total + 15) \ 6 To 49
For N5 = 5 To N6 - 1
Sum5 = N5 + N6
For N4 = 4 To N5 - 1
Sum4 = Sum5 + N4
For N3 = 3 To N4 - 1
Sum3 = Sum4 + N3
For N2 = 2 To N3 - 1
Sum2 = Sum3 + N2
N1 = Total - Sum2
If N1 < 1 Then Exit For
If N1 < N2 Then
iRow = iRow + 1
Cells(iRow, col) = N1 & "-" & N2 & "-" & N3 & "-" & N4 & "-" & N5 & "-" & N6
End If
Next N2
Next N3
Next N4
Next N5
Next N6
Next
Application.ScreenUpdating = True
End Sub
[/VBA]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
Basically what I am trying to achieve is this.
I would like to pick the “SubSet” figure up from cell “D3”. The reason for this is so that I can input alternative figures as opposed to having it hard coded.
I would like to pick up the numbers to use in the combinations from cells "D4 to D52". There could be 7 numbers or more, which means that there will be many empty cells from the last number to use down to the bottom.
These figures are in the sheet named “Numbers In Selection".
I would like the combinations output to the sheet named “Results” one combination per cell seperated with a "-" starting in cell “A1” and continuing down.
For example, if we were to use a "SubSet" of 6, and the figures ...
I must admit that looking at the code it is probably far too much for what I am trying to achieve, I just wanted to produce the quickest code to produce the results, but I think I have lost my way drastically.
Unfortunately it is not what I am after. I particularly want to extract the data from the “Numbers In Selection” sheet. The numbers used to make up the combinations from the range will probably not be in numerical order.
I have attached a spreadsheet with two Modules.
Module1 picks the data up from the set criteria in the "Numbers In Selection" sheet and works.
Module2 is a copy of Module1 and is the one I have tried to adapt to pick up the numbers to use from the range.
I have changed some of the cell locations from previously posted but the cells in the two Modules are now correct. I have also changed “SubSet” to “BallsDrawn”.
Just to clarify.
There will be blanks and numbers in C7-C55 and you want all the combinations of these numbers.
Is there any reason not to sort these ascending and and working with that smaller range?
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
The range for input of the numbers to be used in the combinations is "D7" to "D55".
There will only be blanks after the last number to use in the range.
For example, if we use the numbers below they would be ...
Based on your module1 code, use the generated combinations with Offset to get corresponding items from Column D
[VBA]Option Explicit
Sub Combinations_From_Criteria()
Dim Counter1 As Long
Dim Counter2 As Long
Dim CountOff()
Dim Dummy
Dim MaxOff()
Dim myWrap As Long
Dim NewComb As String
Dim NumOfComb As Long
Dim SepChar As String ' Character used between EACH combinations numbers.
Dim SpecificNumbers As Variant
Dim BallsDrawn As Long ' The length of EACH individual combination.
Dim BallsDrawnFrom As Long ' The maximum number to be drawn from
Dim TotalSpecified As Long
Dim MyDraw As String
Dim i As Long
myWrap = 999 ' Select how many combinations for EACH column.
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
With Sheets("Numbers In Selection").Select
BallsDrawn = Range("D2").Value ' The Total Numbers Drawn.
BallsDrawnFrom = Range("D3").Value ' The Total Number Drawn From.
Range("C57").Select
With Sheets("Results").Select
Cells.EntireColumn.Delete
Range("A1").Select
SepChar = "-" ' The Character Used to Separate the Numbers ( These Work , ; - = ).
NumOfComb = Application.Combin(BallsDrawnFrom, BallsDrawn)
ReDim CountOff(BallsDrawn)
ReDim MaxOff(BallsDrawn)
For Counter1 = 1 To BallsDrawn
CountOff(Counter1) = Counter1
MaxOff(Counter1) = BallsDrawnFrom - BallsDrawn + Counter1
Next Counter1
For Counter1 = 1 To NumOfComb
NewComb = ""
For Counter2 = 1 To BallsDrawn
NewComb = NewComb & Application.WorksheetFunction.Text(CountOff(Counter2), "00") _
& SepChar
Next Counter2
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
MyDraw = ""
For i = 1 To BallsDrawn
MyDraw = MyDraw & Sheets(1).Range("D6").Offset(Split(NewComb, "-")(i - 1)) & "-"
Next
ActiveCell.Offset(((Counter1 - 1) Mod myWrap), Int((Counter1 - 1) / myWrap)) = _
Left(MyDraw, Len(MyDraw) - Len(SepChar))
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CountOff(BallsDrawn) = CountOff(BallsDrawn) + 1
Dummy = BallsDrawn
While Dummy > 1
If CountOff(Dummy) > MaxOff(Dummy) Then
CountOff(Dummy - 1) = CountOff(Dummy - 1) + 1
For Counter2 = Dummy To BallsDrawn
CountOff(Counter2) = CountOff(Counter2 - 1) + 1
Next Counter2
End If
Dummy = Dummy - 1
Wend
Next Counter1
Cells.EntireColumn.AutoFit: Cells.EntireColumn.HorizontalAlignment = xlCenter
End With
End With
With Application
.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End Sub
[/VBA]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
I think I have confused things here.
Module2 is a copy of Module1 and Module2 is the one I have tried to adapt to pick the numbers up from the range to use in the combinations. Module2 has no relevance to the cells "D2" or "D3". The data to be used is in cell "D6" for the number of balls in each combination and the cells "D7" to "D55" for the numbers to be used in the combinations.
I will put a formula in to count the numbers in the range and then get the Macro to recognise that cell.
I will try and work out a way to loop through the numbers in the range if I can to make it more structured.
Thanks for ALL your time and effort on this. I have got it working nicely.
I noticed that the Macro will ONLY work if I use BOTH these lines of code ...
[vba] BallsDrawnFrom = Range("C8").Value ' The Total Number Drawn From.
[/vba]
[vba] MyDraw = MyDraw & Sheets("Criteria").Range("C8").Offset(Split(NewComb, "-")(i - 1)) & "-"
[/vba] ... although they refer to the same cell, but this is not a problem.
What would I need to change or adapt to get the output in the "Results" sheet to be formatted as two digits "00" please.
I would use this to define the total number (if appropriate)
[vba]BallsDrawnFrom = Range(Cells(7, 4), Cells(7, 4).End(xlDown)).Cells.Count ' The Total Number Drawn From.[/vba]
As a good coding practice, rather than using select, create a variable reference to both sheets and qualify all range references. This way you can avoid Selecting other than to finally change to the Results sheet. Your code will run quicker and can be run from any location.
eg
[vba] Dim wsNum As Worksheet
Set wsNum = Sheets("Numbers in Selection")
With wsNum
BallsDrawn = .Range("D2").Value ' The Total Numbers Drawn.
BallsDrawnFrom = Range(.Cells(7, 4), .Cells(7, 4).End(xlDown)).Cells.Count ' The Total Number Drawn From.
[/vba]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
Thanks for the thumbs up on that MD, I think I understand what you mean and will definately use that in future coding.
As far as what would I need to change or adapt to get the output in the "Results" sheet to be formatted as two digits "00", for example :-
Thanks for the reply.
I have adjusted the code as to my understanding of your comments.
When I incorporated the variable for the “Criteria” sheet this is what I found.
I noticed that I cannot run it from the “Results” sheet as it comes up with the error “Invalid Procedure Call Or Argument” where I could when I used select, not a problem though as I will be running it from a button on the “Criteria” sheet.
When you say qualify all range references do you mean use ...
[vba]BallsDrawn = Cells(7, 3).Value[/vba]
... instead of ...
[vba]BallsDrawn =Range("C7").Value[/vba]
... for all the references containing a range in the Macro?
When I incorporated the variable for the “Results” sheet this is what I found.
It deletes everything on the “Criteria” sheet and just outputs the “SepChar” starting in “A1” and going down without any numbers.
Do you think it has something to do with the section of code below ...
... because this is referencing the cell “C8” in the “Criteria” sheet which did contain the “BallsDrawnFrom” number before the introduction of ...
[vba]BallsDrawnFrom = Range(.Cells(9, 3),.Cells(9, 3).End(xlDown)).Cells.Count ' The Total Number Drawn From.[/vba]
I am just trying to understand for future reference so I will not need to seek help as often and make my coding more structured, faster and easier to read.
52").Cells.SpecialCells(xlCellTypeConstants).CountA
Reply With Quote
