To whom much is given...

[jaeb4u2c]

To Whom It May Concern:

Listen, I could really use your help with an excel question and thought you might be able to assist me. I will attached a copy of the excel workbook for your perusal and the password if you will send me an e-mail address. Let me explain what I am trying to accomplish with this excel worksheet.

I have a tab named "Combo" and there you will find a pre-selected index row of numbers which represent the Red (H) and Blue (C) numbers that was put together in the tab named "Permed Numbers." All of the numbers in row B3:P3 are Red (H) numbers and all of the numbers in B4:P6 are Blue (C) numbers.

As you will see from the format on the worksheet I have placed the number "8" in cell A9 and letters "H, C, C, H, H, C" in cells B9:G9. However this is just for an example, because I want to be able to input whatever starting number I choose from all of the numbers in my index (1-56). And I want to be able to input the pattern that I want these numbers to conform to: "H, C. C. H, H, C" and then give me that pattern in all the combinations that are possible for that number. Let me clarify something right here about the way these numbers are processed. The number that I select, in this case "8" will also appear as a constant in the first cell of all the cells that are produced in this combination series. The number "8" is in the red cell and has the designation of "H" and therefore, when I select that number I want that particular number to be constant in all of the combinations produced. It is only the remaining numbers which conform to this pattern that I want to change. If I change the pattern to C, C, H, C, H, C and I choose a different number (e.g., 7) I want the code to process this pattern and give me all the possible combinations for this pattern using "7" as my first, or constant, number.

In closing, when formulating this code keep in mind that the numbers that are produced in the combination function must be greater than the previous number. In other words if my first, or primary, constant number is "8" then the following numbers must be greater than "8" and each successive number must be greater than the previous number, consistent with the pattern that I have selected for execution. Let me give you a further example of how it might look when this code is executed:

Num1 Letter1 Letter2 Letter3 Letter4 Letter5 Letter6
8 H C C H H C

Combinations:

8 9 10 15 16 19
8 9 11 15 16 19
8 9 12 15 16 19
8 9 13 15 16 19
8 9 14 15 16 19
8 9 19 20 21 22
8 9 19 20 21 23
8 9 19 20 21 24


If you compare these numbers to the pattern which i've selected and look at the index in the excel worksheet you will see that this pattern conforms to these numbers. It might also be helpful if you included a sort command so that the numbers produced are in precise numerical increments. I know that this is probably a lot to ask; however, I repose every confidence that there are those who can help with this and I will be eternally grateful for any assistance given in resolving this excel problem. I will look forward to hearing from you.


Jaime

 

[al_b_cnu]

Hi Jaime,

Cant look at this until tomorrow am (local time), but
- will the Hot & Cold number ranges be ascending?
- You mentioned 56 index numbers, isnt this 60 - 15 hot & 45 cold?

 

[al_b_cnu]

For the record, we went offline with this one.

Jaime wanted a lottery numbers combination generator, but with conditions, namely he had a set of 'hot' numbers, a set of 'cold' numbers & a pattern to be followed when creating the combinations.

The following solution expects:

The 'Hot' numbers are in sheet 'Combo', range B3:P3
The 'Cold' numbers are in sheet 'Combo', range B4:P6
The required combination pattern is in range A9:F9

Rules for the combination pattern are:
'H' or 'Hot' (any case): 'hot' numbers only to be placed in the position
'C' or 'Cold' (any case): 'Cold' numbers only to be placed in the position
a number: This constant to be in this position for all combinations. Any hot / cold numbers to the left of this constant position to be less than the constant, any hot/cold numbers to the right of this costant position to be greater than the constant.
Any other value: treated as text & will appear in the position This allows you to specify < 6 number combinations.

For example if the 'hot' numbers are 1,3,5,7,9,11,13,15,17 and the cold numbers are 2,4,6,8,10,12,14,16, the pattern: 3,h,c,11,space,space will produce all the combinations between 3,5,6,11 and 3,9,10,11 inclusive.


The code writes the combinations in columns A to F starting at row 12, overflowing to columns H:M, etc if necessary, also updates a progress cell I8 for every 5,000,rows written.

Option Explicit
Public Const cProgressCell As String = "I8"
Dim gHot() As Integer
Dim gCold() As Integer
Dim gPattern(1 To 6) As Variant
Dim gTemplate(1 To 6) As String
Dim gData(1 To 6) As Variant
Dim gCFData(0 To 6) As Integer
Dim gRow As Long
Dim gCol As Integer
Dim gProgress As Long
Dim wsCombo As Worksheet
Sub Enable()
Application.EnableEvents = True
End Sub
Sub Combos()
Dim iPtr As Integer

Application.EnableEvents = False

gProgress = 0
Set wsCombo = Sheets("Combo")

gCFData(0) = 0
'** store pattern in array **
For iPtr = 1 To 6
    gCFData(iPtr) = 0
    gPattern(iPtr) = wsCombo.Cells(9, iPtr).Text
    Select Case UCase$(gPattern(iPtr))
    Case "H", "HOT", "C", "COLD"
        gTemplate(iPtr) = UCase$(Left$(gPattern(iPtr), 1))
    Case Else
        If IsNumeric(gPattern(iPtr)) Then
            gTemplate(iPtr) = "V"
        Else
            gTemplate(iPtr) = "T"
        End If
    End Select
Next iPtr

'** Store hot numbers in gHot & sort them **
SetupArray DataRange:=wsCombo.Range("B3:P3"), Arr:=gHot

'** Store cold numbers in gCold & sort them **
SetupArray DataRange:=wsCombo.Range("B4:P6"), Arr:=gCold

'** clear out any existing data **
wsCombo.Rows("12:" & Rows.Count).ClearContents
wsCombo.Range(cProgressCell).ClearContents

Application.ScreenUpdating = False

'** Initialise variables **
gRow = 11
gCol = 1
'** Main loop **
Do While GetNext(1)
    Do While GetNext(2)
        Do While GetNext(3)
            Do While GetNext(4)
                Do While GetNext(5)
                    Do While GetNext(6)
                        If InStr("HC", gTemplate(6)) = 0 Then Exit Do
                    Loop
                    If InStr("HC", gTemplate(5)) = 0 Then Exit Do
                Loop
                If InStr("HC", gTemplate(4)) = 0 Then Exit Do
            Loop
            If InStr("HC", gTemplate(3)) = 0 Then Exit Do
        Loop
        If InStr("HC", gTemplate(2)) = 0 Then Exit Do
    Loop
    If InStr("HC", gTemplate(1)) = 0 Then Exit Do
Loop

wsCombo.Range(cProgressCell).Value = Format(gProgress, "#,###,##0") & " rows completed"

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub
Sub SetupArray(ByVal DataRange As Range, ByRef Arr() As Integer)
Dim iPtr As Integer, iPtr1 As Integer, iTemp As Integer
Dim R As Range

'********************
'** Populate array **
'********************
iPtr = 0
ReDim Arr(1 To 1)
For Each R In DataRange
    iPtr = iPtr + 1
    ReDim Preserve Arr(1 To iPtr)
    Arr(iPtr) = Val(R.Text)
Next R

'****************
'** Sort array **
'****************
For iPtr = 1 To UBound(Arr) - 1
    For iPtr1 = iPtr + 1 To UBound(Arr)
        If Arr(iPtr) > Arr(iPtr1) Then
            iTemp = Arr(iPtr)
            Arr(iPtr) = Arr(iPtr1)
            Arr(iPtr1) = iTemp
        End If
    Next iPtr1
Next iPtr
End Sub
Function GetNext(ByVal Index As Integer) As Boolean
Dim iCur As Integer
Select Case gTemplate(Index)
Case "H"
    iCur = GetNextNumber(Arr:=gHot, Index:=Index)
Case "C"
    iCur = GetNextNumber(Arr:=gCold, Index:=Index)
Case "V"
    iCur = gPattern(Index)
    gData(Index) = iCur
    If iCur <= gCFData(Index) Then
        GetNext = False
        Exit Function
    End If
Case Else
    iCur = gCFData(Index)
    gData(Index) = gPattern(Index)
End Select

If iCur <= 0 Then
    GetNext = False
    Exit Function
End If

If Index < UBound(gData) Then
    gCFData(Index + 1) = iCur
Else
    gRow = gRow + 1
    If gRow = Rows.Count Then
        gRow = 12
        gCol = gCol + UBound(gData) + 1
    End If
    wsCombo.Range(Cells(gRow, gCol).Address, Cells(gRow, gCol + UBound(gData) - 1).Address).Value = gData
    gProgress = gProgress + 1
    If gProgress Mod 5000 = 0 Then
        Application.ScreenUpdating = True
        wsCombo.Range(cProgressCell).Value = Format(gProgress, "0,000") & " rows written"
        Application.ScreenUpdating = False
    End If
End If
GetNext = True
End Function
Function GetNextNumber(ByRef Arr() As Integer, _
                       ByVal Index As Integer) As Integer
Dim iPtr As Integer
iPtr = 0
Do
    iPtr = iPtr + 1
    If iPtr > UBound(Arr) Then
        GetNextNumber = -1
        Exit Function
    End If
Loop Until Arr(iPtr) > gCFData(Index)
GetNextNumber = Arr(iPtr)
gData(Index) = GetNextNumber
gCFData(Index) = GetNextNumber
End Function