PDA

View Full Version : Variables Holding Wrong Data



PAB
12-08-2011, 01:00 PM
Good evening,

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:-

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.

' TotalSpecified = Range("D4:D52").Cells.SpecialCells(xlCellTypeConstants).CountA
' TotalSpecified = WorksheetFunction.CountA(Range("D4:D52"))
' TotalSpecified = Range(Range("D4:D52" & Rows.Count).End(xlUp))
' TotalSpecified = Range("D4:D53", .Cells(Rows.Count, 1).End(xlUp).Row)

SpecificNumbers = Range("D4:D52").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
Any help will be greatly appreciated.

Thanks in advance,
PAB

mdmackillop
12-08-2011, 02:16 PM
Can you post a sample workbook?

PAB
12-08-2011, 02:48 PM
Good evening MD,

Please find attached the file.

Kind regards,
PAB

mdmackillop
12-08-2011, 03:27 PM
For Counter1 = 1 To NumOfComb '13,983,816
NewComb = ""
For Counter2 = 1 To SubSet ' 6
NewComb = NewComb & Application.WorksheetFunction.Text(CountOff(Counter2), "00") _
& SepChar
Next Counter2

You have some huge numbers here. NewComb is going to be written 84 million times, and I guess your Dummy loop something similar. I'm scared to try it!

PAB
12-08-2011, 05:47 PM
Hi MD,

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 "D4:D52", 6), albeit the wrong combinations.
Here is the revised code:-

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.

' TotalSpecified = Range("D4:D52").Cells.SpecialCells(xlCellTypeConstants).CountA
' TotalSpecified = WorksheetFunction.CountA(Range("D4:D52"))
' TotalSpecified = Range(Range("D4:D52" & Rows.Count).End(xlUp))
' TotalSpecified = Range("D4:D53", .Cells(Rows.Count, 1).End(xlUp).Row)



Range("D4").Select
TotalSpecified = 1
Do While ActiveCell > 0
TotalSpecified = ActiveCell.Value
TotalSpecified = TotalSpecified + 1
ActiveCell.Offset(1, 0).Select
Loop
TotalSpecified = TotalSpecified - 1



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

Kind regards,
PAB

mdmackillop
12-08-2011, 05:54 PM
I'll look at that tomorrow. Meanwhile an adaption of some code I found
to list combinations by totals. (just for fun!)

'http://en.allexperts.com/q/Excel-1059/possible-numerical-combinations.htm

Sub Combos()

' 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

PAB
12-08-2011, 09:18 PM
Thanks for the reply MD,

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 ...

01
03
08
16
19
25
36
45

... the results would be ...

01-03-08-16-19-25
01-03-08-16-19-36
01-03-08-16-19-45
01-03-08-16-25-36

... down to ...

03-08-16-25-36-45
03-08-19-25-36-45
03-16-19-25-36-45
08-16-19-25-36-45

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.

Thanks in advance,
PAB

mdmackillop
12-09-2011, 06:20 AM
Have a look at this (http://en.allexperts.com/q/Excel-1059/Excel-VBA-list-combinations.htm)

PAB
12-09-2011, 10:23 AM
Thanks for the link MD.

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”.

Thanks in advance,
PAB

mdmackillop
12-09-2011, 02:33 PM
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?

PAB
12-09-2011, 02:45 PM
Hi MD,

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 ...

D7 = 01
D8 = 03
D9 = 08
D10 = 16
D11 = 19
D12 = 25
D13 = 36
D14 = 45

... and cells "D15" to "D55" will be blank.

Thanks in advance,
PAB

mdmackillop
12-09-2011, 03:02 PM
Based on your module1 code, use the generated combinations with Offset to get corresponding items from Column D
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

PAB
12-09-2011, 03:18 PM
Hi MD,

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.

Kind regards,
PAB

PAB
12-09-2011, 04:09 PM
Hi MD,

Don't worry,

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.

Kind regards,
Paul

PAB
12-09-2011, 06:49 PM
Hi MD,

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 ...

BallsDrawnFrom = Range("C8").Value ' The Total Number Drawn From.

MyDraw = MyDraw & Sheets("Criteria").Range("C8").Offset(Split(NewComb, "-")(i - 1)) & "-"
... 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.

Thanks in advance,
PAB

PAB
12-09-2011, 09:09 PM
Ignore.

mdmackillop
12-10-2011, 06:47 AM
I would use this to define the total number (if appropriate)
BallsDrawnFrom = Range(Cells(7, 4), Cells(7, 4).End(xlDown)).Cells.Count ' The Total Number Drawn From.
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
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.

PAB
12-10-2011, 11:06 AM
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 :-

04-08-11-15-21-45

what do I need to do please?

Thanks in advance,
PAB

mdmackillop
12-10-2011, 11:34 AM
For i = 1 To BallsDrawn
MyDraw = MyDraw & Format(Sheets(1).Range("D6").Offset(Split(NewComb, "-")(i - 1)), "00") & "-"
Next

PAB
12-11-2011, 12:17 PM
Hi MD,

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 ...

BallsDrawn = Cells(7, 3).Value
... instead of ...

BallsDrawn =Range("C7").Value
... 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 ...

'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@

MyDraw = ""

For i = 1 To BallsDrawn

MyDraw = MyDraw &Format(wsCriteria.Range("C8").Offset _

(Split(NewComb,"-")(i - 1)), "00") & "-"

Next

ActiveCell.Offset(((Counter1 -1) Mod myWrap), Int((Counter1 - 1) / myWrap)) = _

Left(MyDraw, Len(MyDraw) -Len(SepChar))

'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ @@@@@@@

... because this is referencing the cell “C8” in the “Criteria” sheet which did contain the “BallsDrawnFrom” number before the introduction of ...

BallsDrawnFrom = Range(.Cells(9, 3),.Cells(9, 3).End(xlDown)).Cells.Count ' The Total Number Drawn From.

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.

Thanks in advance for all your effort,
PAB

mdmackillop
12-11-2011, 12:33 PM
This should run from either sheet

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
Dim wsNum As Worksheet
Dim wsRes As Worksheet


Set wsNum = Worksheets("Numbers in Selection")
Set wsRes = Worksheets("Results")


myWrap = 999 ' Select how many combinations for EACH column.
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
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.
With wsRes
.Cells.ClearContents
.Cells.NumberFormat = "@"
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 & wsNum.Range("D6").Offset(Split(NewComb, sepchar)(i - 1)) & sepchar
Next
wsRes.Cells(1, 1).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
.Activate
.Range("A1").select
End With
End With
With Application
.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End Sub

PAB
12-11-2011, 04:05 PM
Hi MD,

Works great thanks.
Just two points.

(1) Using one number as the combination length produces the first nine numbers as single digits. Using two & three number combinations outputs the combinations as dates. I have searched Google and tried several methods including using “@” as text and including “NewComb = Format("00")” but to no avail. Four numbers and above work great.

(2) When Irun the Macro for the “Numbers In Selection” sheet I want the cursor to go to “A1”in the “Results” sheet, but it doesn’t go to the “Results” sheet or cell “A1”. I have tried using “Cell” instead of “Range”, I have tried moving the position of the code to an alternative position in the code and I have tried prefixing them with “wsNum” & “wsRes” but without success.

Sorting these will finish the Macro nicely.
Thanks in advance,
PAB

mdmackillop
12-11-2011, 04:32 PM
I've edited the code in Post 21 to suit.

You need to activate a sheet before you can select a cell, as above, or use a GoTo command
Application.Goto Sheets(2).Cells(1, 1)

PAB
12-11-2011, 05:23 PM
Hi MD,

Yes that worked, it doesn't show as a date now, I had to add ...

.ErrorCheckingOptions.TextDate = False
... because it gave the error "cells containing years represented as 2 digits".
The problem with this is that it sets this error to "False" for any Excel sheet opened.
Also it is not outputing the combinatioms as two digits.
Is there a way to stop the output showing as dates using number format as opposed to setting it to text?

Thanks in advance,
PAB

mdmackillop
12-11-2011, 05:36 PM
Try a different separator ":" works for me

PAB
12-11-2011, 07:55 PM
Hi MD,

I particularly want ALL the cells in the "Results" sheet to be formatted as "General", even those with the combinations in, which the code below does not change, which is great.
The code below works as needed except for a formatting problem. If the "BallsDrawn" is set to one number as the combination length it produces the numbers 1-9 as single digits. Setting the "BallsDrawn" to two numbers it produces the first number as a single digit and the second number as two digits. For example, if the "BallsDrawn" is set to two numbers and the "BallsDrawnFrom" are ...

01
02
03
11
12
13

... the results produced are ...

1.02
1.03
1.11
1.12
1.13
2.03
2.11
2.12
2.13
3.11
3.12
3.13
11.12
11.13
12.13

Here is the code:-
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
Dim wsCriteia As Worksheet
Dim wsResults As Worksheet
Set wsCriteia = Worksheets("Criteria")
Set wsResults = Worksheets("Results")
myWrap = 1000 ' Select how many combinations for EACH column.
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
With wsCriteia
BallsDrawn = .Range("D6").Value
BallsDrawnFrom = Range(.Cells(7, 4), .Cells(7, 4).End(xlDown)).Cells.Count ' The Total Number Drawn From.
.Activate
.Range("B57").Select
With wsResults
.Cells.ClearContents
SepChar = "."
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 & Format(wsCriteia.Range("D6").Offset _
(Split(NewComb, ".")(i - 1)), "00") & "."
Next
wsResults.Cells(1, 1).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
.Activate
.Range("A1").Select
End With
End With
With Application
.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End Sub
Thanks in advance,
PAB

PAB
12-16-2011, 07:52 AM
Hi MD,

The code runs fine if the "BallsDrawn" are set to 3 numbers or upwards but NOT for 1 or 2 numbers.
I have tried adapting the code below with the inclusion of extra "Format" or "Text" and adding extra "00" but to no avail.

Here is the current code ...
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 total number to be drawn from
Dim TotalSpecified As Long
Dim MyDraw As String
Dim i As Long
Dim wsCriteia As Worksheet
Dim wsResults As Worksheet
Set wsCriteia = Worksheets("Criteria")
Set wsResults = Worksheets("Results")
myWrap = 1000 ' Select how many combinations for EACH column.
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
With wsCriteia
BallsDrawn = .Range("D6").Value
BallsDrawnFrom = Range(.Cells(7, 4), .Cells(7, 4).End(xlDown)).Cells.Count
.Activate
.Range("B57").Select
With wsResults
.Cells.ClearContents
SepChar = "."
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 & Format(wsCriteia.Range("D6").Offset _
(Split(NewComb, SepChar)(i - 1)), "00") & SepChar
Next
wsResults.Cells(1, 1).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
.Activate
.Range("A1").Select
End With
End With
With Application
.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End Sub
This will nicely finish this off.

Thanks in advance.
PAB

mdmackillop
12-20-2011, 03:51 AM
The issue is that 01.02 etc. is seen as a number so the leading 0 is dropped. Format column 1 as follows should solve appearance issues, but be aware the 0 is not there as a text character.

wsResults.Columns(1).NumberFormat = "00.00"

BTW, adding MyDraw and NewComb as Watch items as you step through the code will show values and help track down such errors.

PAB
12-20-2011, 08:18 AM
Thanks MD, that works on two numbers and above but not on one number.
I will do some more investigating to see if I can get it to output as a two digit number regardless of whether it is a one number combination or a ten number combination but outputting the combination as a text string.
Thanks for everything.
I hope you and your family have a merry Christmas and a Happy New Year.

All the very best,
PAB
:xnoel: