Helping a student automate a couple of sheets

[MrSams]

I am a professor at Texas A&M and a student came to me for some help. Excel is not in my bag of tricks so I decided to get some assistance here hopefully so bare with me when I try to explain what he wants.

I want to grab the numbers on tab “Drawn Numbers” from the bottom up starting at I2500:O2500 to I2500:O2 and place them to the “Input Sheet” starting at I49:O101. (Numbers 53 Game 3)
Every time we grab a row from the “Drawn Numbers” sheet I want to move each row down 1 row on the “Input” sheet and then have the Macro in Module 1 automatically take off running. Once complete it continues running with a new row from the “Drawn Numbers” sheet and the process starts over again.
So, row 49 on the “Input” sheet becomes numbers 52, row 50 becomes 53, row 49 becomes 54 and so on.


Here is the Macro in Module 1 that needs to run "after" the Input sheet and drawn Numbers sheet copy and paste data. I need help automating the Input and Drawn Numbers sheet. This Macro runs great. Its just included so we can tie into this after the numbers from the Drawn Numbers sheet is copied and pasted into the Input sheet

Option Explicit

Sub ertert()
Dim x, i&, j&
With Sheets("Counter Totals")
    x = .Range("A2:CM" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
End With
For i = 1 To UBound(x)
    If (x(i, 1)) = "Game" Then j = j + 1
    If (IsNumeric(x(i, 1))) * (Len(x(i, 1))) Then
        With Sheets("Game" & x(i, 1)).Columns(1).SpecialCells(2)
            .Areas(j)(.Areas(j).Count + 1, 1).Resize(, 91).Value = Application.Index(x, i, 0)
        End With
    End If
Next i
End Sub

Sub ClearGames()
Dim wsh As Worksheet, r As Range
For Each wsh In ThisWorkbook.Sheets
    If Not wsh Is ActiveSheet Then
        For Each r In wsh.Columns(1).SpecialCells(2).Areas
            r.Resize(, 91).Offset(1).CLEAR
        Next
    End If
Next wsh
End Sub

I understand with out all the data from the external sheets it would be hard for you to test. If you all would be so kind to "include" a macro in the attached sheet or a way for me to copy and paste it into his book I cn try it out and let you all know how the testing does. His book is too large to post

Most thanks for your help here at vbaexpress
MrSams

[SamT]

I want to grab the numbers on tab “Drawn Numbers” from the bottom up starting at I2500:O2500 to I2500:O2

Am assuming you mean "to I2:O2"

Once complete it continues running with a new row from the “Drawn Numbers” sheet and the process starts over again.

Uh. . . No. If that happens, the entire set of numbers, all 2499 Rows, will be transferred in about 10 seconds.

Not sure of your intentions, But I think you need a way for the User to manually trigger the "New Numbers" Procedure. Suggested methods are: 1) Add a CommandButton from the Excel Controls ToolBox Menu. 2) DoubleClicking a certain Cell on the Worksheet. 3) Adding a button from the Excel Forms menu to the Worksheet. 4) Selecting a certain Cell on the Worksheet.

Note that suggestion 3, Excel Forms Button, is a holdover from Excel 4 and is very basic. Its code must be in a standard module and can have any name. The other 3 options must have their code in the relevant Worksheet's Code Page, and the Name of the Procedure determines which shall trigger the 'Numbers Grabbing' procedure.

The actual code for all three options is identical, except that the two Cellular suggestions require an additional line to verify the Certain Cell.

Note that I am unsure of your exact needs.

Option Explicit

Sub NumbersGrabber()
Dim InputSht As Worksheet
Dim DrnNumSht As Worksheet

Static NextRowToUse As Long 'maintains State between calls as long as Workbook is open. With caveats.

Set InputSht = Sheets("Input")
Set DrnNumSht = Sheets("Drawn Numbers")

If NextRowToUse = 0 Then NextRowToUse = 2500
If NextRowToUse = 1 Then MsgBox "GAME OVER! There are no more numbers."

DrnNumSht.Cells(NextRowToUse, "I").Resize(, 7).Copy 'Resize(0 Rows, 7 Columns)
InputSht.Range("I49").Insert shift:=xlShiftDown
NextRowToUse = NextRowToUse - 1

ertert 'Run the etert Procedure

End Sub

Option Number 1: Change the Name of the above Procedure to:

Private Sub CommandButton1_Click()

Option number 2: Replace the Name with:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Target.Address <> "$A$1" Then Exit Sub 'Edit to reflect address of that Certain Cell

Option number 3: Replace the Name with:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub 'Edit to reflect address of that Certain Cell

Option number 4: Assign Macro = NumbersGrabber

[MrSams]

Thanks for the reply SamT. You are correct "to I2:O2"

The intent was to automate the sheets and not manually start each one. When a new set of numbers is copied and pasted the module 1 macro will run its course which takes about 2 minutes by the time it goes through all the other external sheets(not attached for size). He was hoping that once the macro above ran the rest (options you mention) can run automatically. I will discuss your options with him and let you know how they do

[MrSams]

Running option 4 does part as required for the 1st part.
Part 2 would be to copy the next row up which would be the 52s from the "Drawn Numbers" sheet and place them to row 49 Game 3 "Input" sheet
Part 3 trigger 1st module to run in completion
Part 4 start Numbers grabber all over again and go to next row up the 51s and continue to row2

Is this feasible to do?

[SamT]

In the ertert Procedure,add a line that calls NumbersGrabber

    Next i 

NumbersGrabber 'get more numbers
End Sub

Then change

If NextRowToUse = 1 Then MsgBox "GAME OVER! There are no more numbers."

to

If NextRowToUse = 1 Then Exit Sub

Oh yeah, you may need to add .Resize(, 7) to Range("I49")

InputSht.Range("I49").Resize(, 7).Insert shift:=xlShiftDown

[MrSams]

When I do as suggested or at least i hope I did, i get an error

debug.jpg

Please correct this if it is wrong....

Option Explicit 
 
Sub NumbersGrabber() 
    Dim InputSht As Worksheet 
    Dim DrnNumSht As Worksheet 
     
    Static NextRowToUse As Long 'maintains State between calls as long as Workbook is open. With caveats.
     
    Set InputSht = Sheets("Input") 
    Set DrnNumSht = Sheets("Drawn Numbers") 
     
    If NextRowToUse = 0 Then NextRowToUse = 2500 
    If NextRowToUse = 1 Then Exit Sub 
     
    DrnNumSht.Cells(NextRowToUse, "I").Resize(, 7).Copy 'Resize(0 Rows, 7 Columns)
    InputSht.Range("I49").Resize(, 7).Insert shift:=xlShiftDown 
    NextRowToUse = NextRowToUse - 1 
     
    ertert 'Run the etert Procedure
    NumbersGrabber 'get more numbers

End Sub

thanks SamT

[SamT]

If I comprehend your issue, you want a set of numbers applied to Sheet "Input," then run ertert, then apply the next set of numbers, the run ertert. . .Rinse and repeat.

In that case, Module 1 code should be

Option Explicit 
 
Sub ertert() 
    Dim x, i&, j& 
    With Sheets("Counter Totals") 
        x = .Range("A2:CM" & .Cells(Rows.Count, 1).End(xlUp).Row).Value 
    End With 
    For i = 1 To UBound(x) 'The LBound of x is 0 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
        If (x(i, 1)) = "Game" Then j = j + 1 
        If (IsNumeric(x(i, 1))) * (Len(x(i, 1))) Then 
            With Sheets("Game" & x(i, 1)).Columns(1).SpecialCells(2) 
                .Areas(j)(.Areas(j).Count + 1, 1).Resize(, 91).Value = Application.Index(x, i, 0) 
            End With 
        End If 
    Next i 
    NumbersGrabber 'get more numbers '<<<<<<<<<<<<<<<<<<<<<<

End Sub 
 
Sub ClearGames() 
'as is
End Sub 

Sub NumbersGrabber() 
    Dim InputSht As Worksheet 
    Dim DrnNumSht As Worksheet 
     
    Static NextRowToUse As Long 'maintains State between calls as long as Workbook is open. With caveats.
     
    Set InputSht = Sheets("Input") 
    Set DrnNumSht = Sheets("Drawn Numbers") 
     
    If NextRowToUse = 0 Then NextRowToUse = 2500 
    If NextRowToUse = 1 Then Exit Sub 
     
    DrnNumSht.Cells(NextRowToUse, "I").Resize(, 7).Copy 'Resize(0 Rows, 7 Columns)
    InputSht.Range("I49").Resize(, 7).Insert shift:=xlShiftDown 
    NextRowToUse = NextRowToUse - 1 
     
    ertert 'Run the etert Procedure
    '<><><><><><><><><><><>
     
End Sub

However, Sub ertert runs on every contiguous block of cells on the entire sheet every time it runs, so it doesn't make sense to "Rinse and repeat."

Further, ertert pulls values from Sheet "CounterTotals" and puts them in a Game sheet. NumbersGrabber puts values in Sheet "Input," but ertert doesn't use them.

[SamT]

As to the error you are getting, I suspect. . .

This all pertains to i = 1

Sub ertert() 
 '
'

'If i = 1, that is the second index of x 
    For i = 1 To UBound(x) 'For each cell in Sheets("Counter Totals").Range ("A" and down) 
 
       'at i = 1, x(i, 1).Valur =  Sheets("Counter Totals") .Range("A3").Value
       If (x(i, 1)) = "Game" Then j = j + 1  'If cell A3  = "Game" then
       'Since A3 is a number, J = 0 at this time

        If (IsNumeric(x(i, 1))) * (Len(x(i, 1))) Then 
            With Sheets("Game" & x(i, 1)).Columns(1).SpecialCells(2) 'There is only one Game sheet in the Screenshot, Game3
             .Areas(j)(.Areas(j).Count + 1, 1).Resize(, 91).Value = Application.Index(x, i, 0)  'j = 0 at this time. There is no Areas(0)

A simple change might fix that. Add Option Base 1 below Option Explicit. Option Base tells the Compiler where to start indexing Arrays. The Default base is Zero.

OR
Edit the code

 
For i = Lbound(x)  to UBound(x)

[MrSams]

SamT

This works perfectly for dropping the numbers down on the Input sheet. However it does not grab the new numbers from rows 54 up for the copy and paste. Maybe this will help to follow a flow chart so to speak

Start.jpg

Run Module 1

copy and paste new set of numbers from Drawn Numbers
Step 2 copy new set of numbers and paste to Input.jpg

step 3 new set of numbers in rows 49-101.jpg

Note how all numbers moved down from rows 49 to 101as new numbers "52" went to row 49

Run Module

Copy and paste new set of numbers


step 4 new set of numbers in rows 49-101.jpg

Rinse and Repeat

[SamT]

it does not grab the new numbers from rows 54 up for the copy and paste

All those screenshots show numbers above 54?

I don't understand.

[MrSams]

If you look at the spreadsheet number 53 is in row 49, 54 is in row 50 ad so on

I am only copying form the Drawn Numbers sheet and pasting to the Input sheet. The numbers can be any digit in any given row but the flow will be the same ..... Run module 1, copy data from Drawn numbers , paste in Input and all rows of numbers move down one row ..... run module 1 .... rinse

[SamT]

If you look at the spreadsheet number 53 is in row 49, 54 is in row 50 ad so on

That is what you said you wanted.

What's the issue?

[MrSams]

The macro does not copy the new numbers to the input sheet. It only makes all the numbers go down a row until they are all gone on the Input sheet

I am so sorry SamT, Here is the book with your Macro in it. "Please" correct for me

[SamT]

It works as advertised for me

[MrSams]

Let me show him this and put it in his book

Thanks so much and ill let you know as soon as i can

[MrSams]

SamT

When the Macro is placed in the book it copies and paste perfectly to row 49 however the Module to run the "Counter Totals" sheet does not run automatically. We still have to manually click on a button for that to run. We were hoping to have it continuously run all the rows

[SamT]

Jeez, Louise! Read the code.

Even if you don't understand VBA, at least READ THE COMMENTS in the code.

CODE]
Sub NumbersGrabber()
'
'
'
'
'Run the etert Procedure
'ertert '<-------- UnComment after testing

End Sub
/CODE]

[MrSams]

SamT

Sorry for late reply and yes I read the notes. I was not told the entire story nor paying close attention. Here is the disconnect. The Input sheet is in a book all by itself called "TS 4+ BB Game 3 (Macro Numbers Input)-1.xlsm" and the "counter totals" is in a total different book called "TS Game 3_50 COUNTERS-1.xlsm". I am certain this makes a difference. How do we connect them so that after the c wash and rinse (copy and paste) runs it automatically runs the "TS Game 3_50 COUNTERS-1.xlsm" and then back to the copy and paste?

So VERY sorry for ANY and ALL misunderstandings. I can upload the other book once I shrink it down if you need it in order to help us. Your knowledge is worth its weight in gold sir.

Here is the other book

[MrSams]

Even if I place all the data in one book the Macro you provided does the copy and paste move down well but the Macro I provided in Module 1 in my example book does not operate at all. The Macro I asked for should trigger the "Counters Total Macro" with a sub routine??

[SamT]

How do we connect them so that after the c wash and rinse (copy and paste) runs it automatically runs the "TS Game 3_50 COUNTERS-1.xlsm" and then back to the copy and paste?

Without going into Error Checking, Make sure both books are Open. Note that Any Macro can check for open books and open them if needed, But why don't we wait until the code is working with that for now.

Real basic, 'cuz I have to leave now.

Put this in a Standard Module in TS Game 3_50 COUNTERS-1.xlsm

Option Explicit
 
Sub ertert()
    Dim x, i&, j&
    With Sheets("Counter Totals")
        x = .Range("A2:CM" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
    End With
    For i = 1 To UBound(x) 'The LBound of x is 0 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
        If (x(i, 1)) = "Game" Then j = j + 1
        If (IsNumeric(x(i, 1))) * (Len(x(i, 1))) Then
            With Sheets("Game" & x(i, 1)).Columns(1).SpecialCells(2)
                .Areas(j)(.Areas(j).Count + 1, 1).Resize(, 91).Value = Application.Index(x, i, 0)
            End With
        End If
    Next i
    Workbooks("TS 4+ BB Game 3 (Macro Numbers Input)-1.xlsm").NumbersGrabber 

End Sub

And this in a Standard Module in "TS 4+ BB Game 3 (Macro Numbers Input)-1.xlsm"

Option Explicit

Sub NumbersGrabber()
    Dim InputSht As Worksheet
    Dim DrnNumSht As Worksheet
     
    Static NextRowToUse As Long 'maintains State between calls as long as Workbook is open. With caveats.
     
    Set InputSht = Workbooks("TS Game 3_50 COUNTERS-1.xlsm").Sheets("Input")
    Set DrnNumSht = Sheets("Drawn Numbers")
     
    If NextRowToUse = 0 Then NextRowToUse = DrnNumSht.Cells(Rows.Count, "I").End(xlUp).Row
    If NextRowToUse = 1 Then Exit Sub
     

    DrnNumSht.Cells(NextRowToUse, "I").Resize(, 7).Copy 'Resize(0 Rows, 7 Columns)
    InputSht.Range("I49").Resize(, 7).Insert shift:=xlShiftDown
    NextRowToUse = NextRowToUse - 1

    'Run the etert Procedure
    'Workbooks("TS Game 3_50 COUNTERS-1.xlsm".ertert '<-------- UnComment after testing
     
End Sub

Make sure there is only one sub with the same name in any Workbook.

Notre the Workbook is specified in each Call to the other routine.