Help with my Macro

GRODD 20 Reputation points
2026-07-07T15:52:59.79+00:00

I have a macro and need some help. I want to play a game and have this macro If you place a E or O in I J 3, U or D in T U 3, U or D in AE AF 3, E or O in I J 11, U or D in T U 11, U or D in AE AF 11, E or O in I J 19, a U or D in T U 19 and a U or D in AE AF 19, E or O in I J 29 and 32 and a U or D in T U 29 and 32 and a U or D in AE AF 29 and 32 it should ONLY leave you with 1 to 3 max numbers for each ball. You just have to figure out which pattern to play per ball that leaves only 1 to 3 numbers per ball in AI AJ AK AL AN. For some reason i can not get it to display on a separate sheet what those numbers are left it should be displaying.

I am NOT a macro writer and need someone to actually change this for me to do what i am asking. Thank you so much. I tried to upload the file and it would not allow that so i uploaded a snip. Thank you in advance

Option Explicit

'the cell where the increment number is shown on a sheet
    Public Const incNumberCell = "AH22" ' currently only used in CopySelectedEntries() process

'this array will hold the indicators for deciding which
    'groups to process on the active Game # sheet
    Public groupIndicators(1 To 9) As Boolean
    Public Const gp1FirstRow = 3 ' first row of numbers to look at
    Public Const gp1LastRow = 7 ' last row of numbers to look at

    Public Const gp2FirstRow = 11 ' first row of numbers to look at
    Public Const gp2LastRow = 15 ' last row of numbers to look at

    Public Const gp3FirstRow = 19 ' first row of numbers to look at
    Public Const gp3LastRow = 23 ' last row of numbers to look at

    Public extraBallIndicators(1 To 9) As Boolean 'associated extra ball for each group
    Public Const xtraBall_Gp1Row = 29
    Public Const xtraBall_Gp2Row = 32
    Public Const xtraBall_Gp3Row = 35

    'this is the column we put results of conditional format tests into
    'to then test if color will be black or not
    '
    Public Const cfTestCFFormulaCol = "BV" ' where we copy 1 conditional format formula & condition to
    Public Const cfTestCFColorResultCol = "BW" ' where we test the results of cell in BV on same row
    Public Const cfTestCFBonusBallCol = "CA"
    'formula for BW2 to be filled down if ever deleted
    ' =IF(BV2=TRUE,displayedcolor(BV2,TRUE,FALSE),"NC")
    Public Const cfTestResultFirstRow = 2

    'these deal with the conditionally formatted cells on a sheet
    Public Const first_CF_Row = 2 'the first row we have to test
    Public Const last_CF_Row = 72 ' the last row we have to test for any CF Cell
    Public Const last_BonusBall_Row = 16 ' the last row for the 6th ball testing - not used at this time
    Public Const cf_Ball1_Col = "AI" 'column 1st ball is exposed in
    Public Const cf_Ball5_Col = "AM" 'column the 5th ball is exposed in
    Public Const cf_Ball6_Col = "AN" 'column 6th ball is exposed in
    Public Const cf_FirstBallPossiblesCol = "AP" '1st column we will copy chosen entries from AI:AN into
    Public Const cf_BonusBallPossiblesCol = "AU" 'last column we will copy chosen entries from AI:AN into (BB column)
    
    'each of these groups are 3 columns wide
    'not sure we need these at this time - Not used as of 09 JULY 2015
    Public Const comparisonGroup1StartCol = "AW"
    Public Const comparisonGroup2StartCol = "BA"
    Public Const comparisonGroup3StartCol = "BF"
    Public Const comparisonGroup4StartCol = "BJ"


Sub ClearAll()
  Dim lastCombinedRowToClear As Long ' for clearing BV:CA section

    With Application
         .EnableEvents = False
         .ScreenUpdating = False
    End With
    
    With ActiveSheet
'        Clear all the E cells
         .Range("I3:I7").ClearContents
         .Range("I11:I15").ClearContents
         .Range("I19:I23").ClearContents
    
'        Clear all the O cells
         .Range("J3:J7").ClearContents
         .Range("J11:J15").ClearContents
         .Range("J19:J23").ClearContents
    
'        Clear all the U cells
         .Range("T3:T7").ClearContents
         .Range("T11:T15").ClearContents
         .Range("T19:T23").ClearContents
         
         .Range("AE3:AE7").ClearContents
         .Range("AE11:AE15").ClearContents
         .Range("AE19:AE23").ClearContents
         
'        Clear all the D cells
         .Range("U3:U7").ClearContents
         .Range("U11:U15").ClearContents
         .Range("U19:U23").ClearContents
         
         .Range("AF3:AF7").ClearContents
         .Range("AF11:AF15").ClearContents
         .Range("AF19:AF23").ClearContents
    
'        Clear all the BB cells
         .Range("I29:J29").ClearContents
         .Range("I32:J32").ClearContents
         .Range("I35:J35").ClearContents
         
         .Range("T29:U29").ClearContents
         .Range("T32:U32").ClearContents
         .Range("T35:U35").ClearContents
         
         .Range("AE29:AF29").ClearContents
         .Range("AE32:AF32").ClearContents
         .Range("AE35:AF35").ClearContents

'        Initialize the counter in cell AH22
         .Range("AH22").Value = 0

       'clear out any old identified possible balls area before continuing:
        'same as Range("AP2:AU72").ClearContents
        'but uses predefined values so you can change those when needed and code still runs properly.
        Range(cf_FirstBallPossiblesCol & first_CF_Row & ":" & cf_BonusBallPossiblesCol & last_CF_Row).ClearContents

      'clear out any previous combined results entries
        lastCombinedRowToClear = RDB_Last(1, Columns(cfTestCFFormulaCol & ":" & cfTestCFBonusBallCol))
        If lastCombinedRowToClear < cfTestResultFirstRow Then
          lastCombinedRowToClear = cfTestResultFirstRow ' never less than row 2
        End If
        Range(cfTestCFFormulaCol & cfTestResultFirstRow & ":" & cfTestCFBonusBallCol & lastCombinedRowToClear).Clear ' clear entries & Formats
      'and reset column widths to narrow
        Columns(cfTestCFFormulaCol & ":" & cfTestCFBonusBallCol).Columns.AutoFit
    End With
    
    With Application
         .EnableEvents = True
         .ScreenUpdating = True
    End With
End Sub

Sub Increment()
    Const NoCFApplied = "NC"
    Dim coloffset As Integer
    Dim rowoffset As Long
    Dim rng As Range
    Dim letter As String
    Dim combination As String
    Dim i As Integer
    Dim anyCell As Range
    Dim incValue As Integer ' to control the 1 to 512 loop counting
    'these are for evaluating results of any given cell in AI2:AN72's conditional format formulas
    Dim lastTestRow As Long
    Dim cf_Count As Integer
    Dim targetCell As Range
    Dim true_RowLoop As Long
    Dim someResultWasTrueFlag As Boolean

    'these are for building up possible ball text entries
    Dim rowPtr As Long ' row pointer
    Dim colPtr As Long ' column pointer
    Dim offsetToReportCol As Integer ' used to put selected balls list together

    'show form and get user choices for groups & extra balls to allow user to change.
    'we only show it at the beginning of a new series (1-512)
    If [AH22] = 0 Then
      GroupSelection.Show
    End If
    
    
    With Application
         .EnableEvents = False
         .ScreenUpdating = False
    End With

    'clear out any old identified possible balls area before continuing:
    '****  same as Range("AP2:AU72").ClearContents ****
    'but uses predefined values so you can change those when needed and code still runs properly.
    Range(cf_FirstBallPossiblesCol & first_CF_Row & ":" & cf_BonusBallPossiblesCol & last_CF_Row).ClearContents

    
'incValue was used to provide automatic looping of all values from 1 to 512 when we had hopes of extracting
'the 'chosen' possible numbers, but since that failed, this line and its corresponding Next statement
'have been removed by commenting them out.  This lets us reimplement this if we ever overcome the other problems. JLL 7/9/2015
'For incValue = 1 To 512 ' temporarily disabled for testing other processing - don't forget the related NEXT
    
        DoEvents ' allows other 'background' things in Windows to take place.
    
        If Not IsNumeric([AH22]) Then
           [AH22] = 0
        End If
        
        If [AH22] < 0 Or [AH22] > 511 Then
          GoTo SubExit:
        End If
        
        coloffset = Int([AH22] / 64) * 10
        
        [AH22] = [AH22] + 1 ' if the incValue loop is re-implemented,
        'change this line to become
        '[AH22] = incValue
        'without the ' for comment, of course
        
        rowoffset = [AH22] Mod 64
        If rowoffset = 0 Then rowoffset = 64
        
        Set rng = Application.Evaluate("=OFFSET(INDEX('the diff letter combos'!$E$1:$M$64," & rowoffset & ", ),," & coloffset & ")")
    
        combination = vbNullString
        
        For i = 1 To 9
            DoEvents ' allows other processes to run also
            letter = rng(i)
            combination = combination & letter
            
            Select Case i
                    'this is group #2
                   Case Is = 1
                     If (groupIndicators(2)) = False Then
                      'Handle the regular/non-bonus balls
                      'if groupIndicators(#) = False it means go ahead and process it
                      'so, when groupIndicators(#) is TRUE you would not.
                        If letter = "U" Then
                           Range("T3:T7").Value = letter
                           Range("T3:T7").Offset(, 1).ClearContents
                        Else
                           Range("U3:U7").Value = letter
                           Range("U3:U7").Offset(, -1).ClearContents
                        End If
                     End If
                     If (extraBallIndicators(2)) = False Then
                      'Handle the bonus balls
                      'if extraBallIndicators(#) = False it means go ahead and process it
                      'so, when extraBallIndicators(#) is TRUE you would not.
                        If letter = "U" Then
                           Range("T29").Value = letter
                           Range("T29").Offset(, 1).ClearContents
                        Else
                           Range("U29").Value = letter
                           Range("U29").Offset(, -1).ClearContents
                        End If
                     End If
            
                   Case Is = 2
                     'this is group #3
                      If (groupIndicators(3)) = False Then
                      'Handle the regular/non-bonus balls
                      'if groupIndicators(#) = False it means go ahead and process it
                      'so, when groupIndicators(#) is TRUE you would not.
                        If letter = "U" Then
                           Range("AE3:AE7").Value = letter
                           Range("AE3:AE7").Offset(, 1).ClearContents
                        Else
                           Range("AF3:AF7").Value = letter
                           Range("AF3:AF7").Offset(, -1).ClearContents
                        End If
                     End If
                     If (extraBallIndicators(3)) = False Then
                      'Handle the bonus balls
                      'if extraBallIndicators(#) = False it means go ahead and process it
                      'so, when extraBallIndicators(#) is TRUE you would not.
                        If letter = "U" Then
                           Range("AE29").Value = letter
                           Range("AE29").Offset(, 1).ClearContents
                        Else
                           Range("AF29").Value = letter
                           Range("AF29").Offset(, -1).ClearContents
                        End If
                     End If
                   
                   Case Is = 3
                     'this is group #5
                      If (groupIndicators(5)) = False Then
                      'Handle the regular/non-bonus balls
                      'if groupIndicators(#) = False it means go ahead and process it
                      'so, when groupIndicators(#) is TRUE you would not.
                        If letter = "U" Then
                           Range("T11:T15").Value = letter
                           Range("T11:T15").Offset(, 1).ClearContents
                        Else
                           Range("U11:U15").Value = letter
                           Range("U11:U15").Offset(, -1).ClearContents
                        End If
                     End If
                     If (extraBallIndicators(5)) = False Then
                      'Handle the bonus balls
                      'if extraBallIndicators(#) = False it means go ahead and process it
                      'so, when extraBallIndicators(#) is TRUE you would not.
                        If letter = "U" Then
                           Range("T32").Value = letter
                           Range("T32").Offset(, 1).ClearContents
                        Else
                           Range("U32").Value = letter
                           Range("U32").Offset(, -1).ClearContents
                        End If
                     End If
                   
                   Case Is = 4
                      'this is group #6
                      If (groupIndicators(6)) = False Then
                      'Handle the regular/non-bonus balls
                      'if groupIndicators(#) = False it means go ahead and process it
                      'so, when groupIndicators(#) is TRUE you would not.
                        If letter = "U" Then
                           Range("AE11:AE15").Value = letter
                           Range("AE11:AE15").Offset(, 1).ClearContents
                        Else
                           Range("AF11:AF15").Value = letter
                           Range("AF11:AF15").Offset(, -1).ClearContents
                        End If
                     End If
                     If (extraBallIndicators(6)) = False Then
                      'Handle the bonus balls
                      'if extraBallIndicators(#) = False it means go ahead and process it
                      'so, when extraBallIndicators(#) is TRUE you would not.
                        If letter = "U" Then
                           Range("AE32").Value = letter
                           Range("AE32").Offset(, 1).ClearContents
                        Else
                           Range("AF32").Value = letter
                           Range("AF32").Offset(, -1).ClearContents
                        End If
                     End If
                    
                   Case Is = 5
                      'this is group #8
                      If (groupIndicators(8)) = False Then
                      'Handle the regular/non-bonus balls
                      'if groupIndicators(#) = False it means go ahead and process it
                      'so, when groupIndicators(#) is TRUE you would not.
                        If letter = "U" Then
                           Range("T19:T23").Value = letter
                           Range("T19:T23").Offset(, 1).ClearContents
                        Else
                           Range("U19:U23").Value = letter
                           Range("U19:U23").Offset(, -1).ClearContents
                        End If
                     End If
                     If (extraBallIndicators(8)) = False Then
                      'Handle the bonus balls
                      'if extraBallIndicators(#) = False it means go ahead and process it
                      'so, when extraBallIndicators(#) is TRUE you would not.
                        If letter = "U" Then
                           Range("T35").Value = letter
                           Range("T35").Offset(, 1).ClearContents
                        Else
                           Range("U35").Value = letter
                           Range("U35").Offset(, -1).ClearContents
                        End If
                     End If
    
                   Case Is = 6
                      'this is group #9
                      If (groupIndicators(9)) = False Then
                      'Handle the regular/non-bonus balls
                      'if groupIndicators(#) = False it means go ahead and process it
                      'so, when groupIndicators(#) is TRUE you would not.
                        If letter = "U" Then
                           Range("AE19:AE23").Value = letter
                           Range("AE19:AE23").Offset(, 1).ClearContents
                        Else
                           Range("AF19:AF23").Value = letter
                           Range("AF19:AF23").Offset(, -1).ClearContents
                        End If
                     End If
                     If (extraBallIndicators(9)) = False Then
                      'Handle the bonus balls
                      'if extraBallIndicators(#) = False it means go ahead and process it
                      'so, when extraBallIndicators(#) is TRUE you would not.
                        If letter = "U" Then
                           Range("AE35").Value = letter
                           Range("AE35").Offset(, 1).ClearContents
                        Else
                           Range("AF35").Value = letter
                           Range("AF35").Offset(, -1).ClearContents
                        End If
                     End If
                   
                   Case Is = 7
                     'This is group #1
                     If (groupIndicators(1)) = False Then
                      'Handle the regular/non-bonus balls
                      'if groupIndicators(#) = False it means go ahead and process it
                      'so, when groupIndicators(#) is TRUE you would not.
                        If letter = "E" Then
                           Range("I3:I7").Value = letter
                           Range("I3:I7").Offset(, 1).ClearContents
                        Else
                           Range("J3:J7").Value = letter
                           Range("J3:J7").Offset(, -1).ClearContents
                        End If
                     End If
                     If (extraBallIndicators(1)) = False Then
                      'Handle the bonus balls
                      'if extraBallIndicators(#) = False it means go ahead and process it
                      'so, when extraBallIndicators(#) is TRUE you would not.
                        If letter = "E" Then
                           Range("I29").Value = letter
                           Range("I29").Offset(, 1).ClearContents
                        Else
                           Range("J29").Value = letter
                           Range("J29").Offset(, -1).ClearContents
                        End If
                     End If
                     
                   Case Is = 8
                      'this is group #4
                      If (groupIndicators(4)) = False Then
                      'Handle the regular/non-bonus balls
                      'if groupIndicators(#) = False it means go ahead and process it
                      'so, when groupIndicators(#) is TRUE you would not.
                        If letter = "E" Then
                           Range("I11:I15").Value = letter
                           Range("I11:I15").Offset(, 1).ClearContents
                        Else
                           Range("J11:J15").Value = letter
                           Range("J11:J15").Offset(, -1).ClearContents
                        End If
                     End If
                     If (extraBallIndicators(4)) = False Then
                      'Handle the bonus balls
                      'if extraBallIndicators(#) = False it means go ahead and process it
                      'so, when extraBallIndicators(#) is TRUE you would not.
                        If letter = "E" Then
                           Range("I32").Value = letter
                           Range("I32").Offset(, 1).ClearContents
                        Else
                           Range("J32").Value = letter
                           Range("J32").Offset(, -1).ClearContents
                        End If
                     End If
    
                   Case Else
                      'this is group #7
                      If (groupIndicators(7)) = False Then
                      'Handle the regular/non-bonus balls
                      'if groupIndicators(#) = False it means go ahead and process it
                      'so, when groupIndicators(#) is TRUE you would not.
                        If letter = "E" Then
                           Range("I19:I23").Value = letter
                           Range("I19:I23").Offset(, 1).ClearContents
                        Else
                           Range("J19:J23").Value = letter
                           Range("J19:J23").Offset(, -1).ClearContents
                        End If
                     End If
                     If (extraBallIndicators(7)) = False Then
                      'Handle the bonus balls
                      'if extraBallIndicators(#) = False it means go ahead and process it
                      'so, when extraBallIndicators(#) is TRUE you would not.
                        If letter = "E" Then
                           Range("I35").Value = letter
                           Range("I35").Offset(, 1).ClearContents
                        Else
                           Range("J35").Value = letter
                           Range("J35").Offset(, -1).ClearContents
                        End If
                     End If
            End Select
        Next ' end of 'i' loop
        '************************************************************************
        'right here is where we want to capture the results of each increment!!!
        'if we can ever figure out just how to do it reliably.
        '************************************************************************


'incValue was used to provide automatic looping of all values from 1 to 512 when we had hopes of extracting
'the 'chosen' possible numbers, but since that failed, this FOR incValue=1 to 512 and this corresponding Next statement
'have been removed by commenting them out.  This lets us reimplement this if we ever overcome the other problems. JLL 7/9/2015
'Next ' end of incValue loop
    
SubExit:
    With Application
         .EnableEvents = True
         .ScreenUpdating = True
    End With
End Sub

Microsoft 365 and Office | Excel | For home | Windows
0 comments No comments

Answer accepted by question author

Kai-H 21,445 Reputation points Microsoft External Staff Moderator
2026-07-08T07:42:08.5466667+00:00

Hi, GRODD

The reason nothing shows up on a separate sheet is that the code to actually write those leftover numbers was never finished. If you look near the middle of the Increment routine, there's a block that literally says "right here is where we want to capture the results of each increment... if we can ever figure out how." Right below it, the loop that was meant to run through all 512 combinations and pull out the surviving numbers is commented out (the notes dated 7/9/2015 explain it was disabled because it "failed"). So the macro sets your E/O and U/D letters and lets the conditional formatting hide numbers, but there is no working step that reads the still-visible numbers in AI:AN and copies them anywhere.

To get what you want, someone needs to add a short routine that, after the letters are placed, scans columns AI through AN, checks which cells are still showing (using your existing displayedcolor helper in BV/BW), collects the 1 to 3 numbers per ball, and writes them onto a results sheet.

Since this is a fairly involved change to a game workbook, it is recommended you post this on the Microsoft Tech Community Excel forum, where VBA folks can rebuild that missing capture section for you.

Was this answer helpful?

1 person found this answer helpful.

0 additional answers

Sort by: Most helpful

Your answer

Answers can be marked as 'Accepted' by the question author and 'Recommended' by moderators, which helps users know the answer solved the author's problem.