Helping a student automate a couple of sheets

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

Code:

---

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

Quote:

---

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"

Quote:

---

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.

Code:

---

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:

Code:

---

Private Sub CommandButton1_Click()

---

Option number 2: Replace the Name with:

Code:

---

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:

Code:

---

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

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

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?

In the ertert Procedure,add a line that calls NumbersGrabber

Code:

---

    Next i

NumbersGrabber 'get more numbers
End Sub

---

Then change

Code:

---

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

---

to

Code:

---

If NextRowToUse = 1 Then Exit Sub

---

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

Code:

---

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

---

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

Attachment 17196

Please correct this if it is wrong....

Code:

---

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

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

Code:

---

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.

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

This all pertains to i = 1

Code:

---

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

Code:

---


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

---

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

Attachment 17201

Run Module 1

copy and paste new set of numbers from Drawn Numbers
Attachment 17202

Attachment 17203

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


Attachment 17204

Rinse and Repeat

Quote:

---

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.

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

Quote:

---

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?

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

It works as advertised for me

Let me show him this and put it in his book

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

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

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]

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

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

Quote:

---

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

Code:

---

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"

Code:

---

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.

when we run Workbooks("TS Game 3_50 COUNTERS-1.xlsm".ertert I get the following error ... note comment taken out

Attachment 17231

When we run Workbooks("TS 4+ BB Game 3 (Macro Numbers Input)-1.xlsm").NumbersGrabber , it cycles through once and then stops

As a suggestion he placed everything into one book (would this be easier?) Each Macro runs very well Independently and there are instruction on the sky blue tabs "Counter Totals" so you can see before and after the Macro runs what to expect.

As always thank you for helping and hanging in here with us on this venture. You are a genius with this and I have a lot to learn once time permits. Here is the file with only two Macros. 1 for the "Input" sheet and 1 for the "Counters Totals" sheet. The file is 9.7MB so I have to add a link so sorry

http://www.mediafire.com/file/lvfh90...put%29_MS.xlsm

I am glad you found a solution.

It is very hard to program without access to all the material, especially when communicating thru a third party.

Unfortunately, Finances restricts me to Excel XP, so your workboor wont run on my computer.