Automating insert of rows at relative position and copy of data between worksheets

[CiderDrinker]

I am a martial arts instructor and I keep my attendance records in an Excel workbook. There is one worksheet for each of four schools, a Master and a Consolidated (as the students are allowed to train at more than one venue, so I need to have a record of their attendance at their "home" venue and any extras they do on top). This works well, but is very laborious when a new student joins, as I need to insert their name into the correct alphabetised position in the Master sheet as well as on all of the individual school worksheets. I would like some advice on how to automate this part of the process. I have researched this via Google but cannot find anything that quite meets what I am trying to achieve. I imagine it would also be useful for anyone else who keeps attendance registers for more than one venue The spreadsheet contains the student name, their home school and the month, with the subsequent columns headed with the numbers 1 to 31 and a formula to sum these (I enter a 1 for each hour they attend under each date). At the moment, when somebody new joins the class, I go to their position in the register, insert a row, and enter their basic details. I then use the following simple macro to copy that row down 11 times (for the remaining months) and insert each of the months of the year <code>Sub CopyDownStudent() For i = 1 To 11 ActiveCell.Offset(1, 0).EntireRow.Insert ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow Next For i = 0 To 11 ActiveCell.Offset(i, 3).Formula = "=DATE(YEAR(NOW())," & i + 1 & ",1)" Next End Sub </code> That works well on the Master sheet, but the really slow bit happens from that point onwards. Each of the school worksheets, and the Consolidated one, references the Master sheet to get the student data (eg =Master!A2), so I have to find the same row number as the first on the new Master sheet, insert 12 rows and then copy the formulae down from the last populated row to the 12 new ones, and then repeat that for each of the schools. Can I please have some help to add that on to the existing macro, ie to identify the rows that have just been created on the Master sheet and replicate the insertion of 12 rows at the same position in each of the other worksheets, then copy the formulae down from the first four columns from the row immediately above the newly inserted rows into each worksheet. I have tried to explain in as much detail as I can what I am trying to achieve, and may have included some irrelevant information in there, but was trying to give some context to better explain it. If I have missed off anything important, please let me know.

<tbody>
</tbody>

 

[Misca]

I believe you'd get away with much smaller workbook & much easier data management & reports if you redesign your table structure:

1. Have a single table for the schools: One row for each school and school names, addresses etc. in their own columns.
2. Add a table for the students: One row for each student and names, addresses, home schools and whatever in their own columns. Add data validation to the home school column so that you can pick the school name from a drop down list. This way you'll eliminate the typing errors.
3. Add a third table for the attendance records with Date, student name and the school name as columns.
4. If you want to keep track on classes given, add a fourth table for different class types as well. Also, if you're keeping track of payments etc. it might be a good idea to add yet another table for that. The most important thing to keep in mind is to store one kind of data in one table and use key fields to link data between tables.

Now that your tables are ready you can have a single worksheet (or userform) where you select the school (and class) when you open your workbook and when a student arrives, you select his name from a drop down & press a button to add a new row to the attendance table from your userform. Once you're done, have the macro clear the user name for you and maybe autosave the workbook whenever a name is added. Now all your data is stored and the rest is just reporting:

If you like the look of your current days in columns / months in rows look for a student add one with a name drop down. Have formulas look from the records table the student name and have a formula mark the cells where the day / month combination matches the columns / rows. Also, a simple countif(s) -formula tells how many classes the student has attended. If you want to, you can add conditional formatting color the cells where the student has attended to classes in other schools (With only four schools it's quite easy to colorcode the schools differently).

 

[CiderDrinker]

I believe you'd get away with much smaller workbook & much easier data management & reports if you redesign your table structure:

1. 
   
   Thank you. These are all perfectly valid suggestions, and some really great ideas and, if I were starting up now, I would follow them, but the fact is I already have a lot of data in this format already (attendance records for the past four years) so a complete redesign of the whole workbook structure is probably not feasible at this point. The only flaw in your idea is that it is possible to train in more than one venue on the same day, which is why the current configuraton is school-driven, rather than just one single attendance worksheet from which the school is selected. Also, I do not use the worksheet onsite at the training venues, but just a simple paper register for each school, which I transfer to Excel at home.
   
   I am grateful for your ideas, which I have taken on board and will consider for next year, but right now I am only looking for some help in automating a part of the current process rather than a complete redesign of the whole spreadsheet.

 

[Misca]

Try the following:

Sub AddStudent()

Dim R As Long
Dim C As Long
Dim Student As String
Dim WS As Worksheet
Dim MyFormula1 As String
Dim MyFormula2 As String


With ActiveCell
    Student = .Value
    R = .Row
    C = .Column
End With


With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With


    For Each WS In Worksheets
        With WS.Cells(R, C)
    'Copies the formulas from the next couple of cells:
            MyFormula1 = .Offset(, 1).Formula
            MyFormula2 = .Offset(, 2).Formula
    'Inserts the rows:
            With .Offset(1).Resize(11)
                .EntireRow.Insert
            End With
    'Adds the values & formulas:
            With .Resize(12, 4)
                .Value = Array(Student, MyFormula1, MyFormula2, "=Date(year(today()),row(A1),1)")
            End With
        End With
    Next WS


With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With


End Sub

 

[CiderDrinker]

Thank you for this. Before I run it, I just have a couple of quick questions.
1. Is this intended to replace my existing code, or to be appended to it?
2. I am familiar with FOR..NEXT loops, but have not before come across FOR EACH. If I understand your coding comments correctly, I think the intention is to use my existing macro to set up the Master sheet (add new student details) and then to run yours to the insert the same number of rows in the same positions in every other worksheet in the workbook. Is that correct?

 

[CiderDrinker]

Ignore the questions above. I have realised it was meant to replace my macro and it works overall well, with the only issue being the copying of formulae down on the school worksheets (instead of copying from the row above where the new ones have just been inserted, it appears to have copied from 12 rows below. For example, if cell B86 on the Master sheet is where I inserted the new student, then cell B86 on each school worksheet should reference it (=Master!B86) as the formula =Master!B85 is on the row above. However, it is currently showing =Master!B98).

However, the code you have given me is very effective and has already saved me a lot of time, so I will work on this, tweaking as needed. Thank you very much for your help, and for the earlier advice. I appreciate it.

 

[Misca]

I tried to make my macro do the same as the code you posted does + what you wrote you wanted it to do. I'd suggest you copy your existing workbook and run this code with F8 to see what each line does. Just make sure you have a student name selected when you run this code. Also, if you F8 the code I'd comment (= put a single quote before the line you want to skip) the "For Each" and "Next WS" lines. These lines make the code do the same steps for the same cells in each worksheet in your workbook, also the hidden ones.

Also, if you don't need the dates to be formulas I'd suggest you change the date formulas into values once they are calculated. The Row-function I've used in my code for months is easy to use in code but might cause problems later if you add/delete rows/cells.

To do this all you need to do is to add a couple of lines into the existing code:

    'Adds the values & formulas:            With .Resize(12, 4)
                .Value = Array(Student, MyFormula1, MyFormula2, "=Date(year(today()),row(A1),1)")
                
                With .Offset(, 3).Resize(, 1)   'Resizes to the date formulas
                    .Calculate  'Calculates the formulas
                    .Value = .Value 'Changes formulas into values
                End With
                
            End With

Replace the existing similar lines of code with this one.

 

[CiderDrinker]

Sorry for the slow reply. Had a busy day yesterday and only just got around to looking at this again. Thanks for the extra help. One thing I didn't notice before was that only 11 rows get inserted into the school sheets, with the net effect that January gets overwritten by December of the new inserted data, but it looks like just changing the value 11 to 12 here should fix that, correct?

'Inserts the rows:
With .Offset(1).Resize(11)

As for the dates, they are only formulae on the Master sheet just to make the January to December fill series work, but there is no reason they could not be values on the school sheets. In fact the same applies to the rest of the formulae in the first four columns of each new inserted row,as they are only references to the same position in the Master sheet (=Master!A99,=Master!B99 etc). Provided the macro pastes this in correctly, then the formulae would not be needed at all.

Thanks again

 

[CiderDrinker]

I am revisiting this now and would like to slim it down. The code provided by Misca has gone a very long way towards achieving what I needed and in fact has negated the need for some elements on which I had previously relied. Putting it very simply, it is no longer necessary to copy formulae down in the way that I was doing. Provided it works correctly, I am perfectly happy for values rather than formulae to be inserted in the secondary (per school) worksheets. There was also a fairly minor issue in that, because For Each was used on every worksheet, including the Master one, the same number of new rows (11) was inserted into every worksheet, whereas it needed to be 12 on the others. The code worked as follows:

Sub AddStudent()

Dim R As Long
Dim C As Long
Dim Student As String
Dim WS As Worksheet
Dim MyFormula1 As String
Dim MyFormula2 As String


With ActiveCell
    Student = .Value
    R = .Row
    C = .Column
End With


With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With


    For Each WS In Worksheets
        If WS.Name <> "CALCS" Then
        With WS.Cells(R, C)
    'Copies the formulas from the next couple of cells:
            MyFormula1 = .Offset(, 1).Formula
            MyFormula2 = .Offset(, 2).Formula
    'Inserts the rows:
            With .Offset(1).Resize(11)
                .EntireRow.Insert
            End With
    'Adds the values & formulas:            With .Resize(12, 4)
                .Value = Array(Student, MyFormula1, MyFormula2, "=Date(year(today()),row(A1),1)")
                
                With .Offset(, 3).Resize(, 1)   'Resizes to the date formulas
                    .Calculate  'Calculates the formulas
                    .Value = .Value 'Changes formulas into values
                End With
                
            End With
        End If
            Next WS


With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With


End Sub

The section starting For Each can be slimmed down. I no longer need the sections that copy formulae from previous cells. All I now need is (run from the Master sheet)

1. Copy the first three cells of the current row (manually inserted and populated before the macro is run)
2. Insert 11 blank rows BELOW the current row
3. Paste the first three cells copied above into all 11 newly created rows
4. Go back to the top of the new group of 12 rows
5. In column D (fourth cell) of each row, paste the series January to December inclusive
6. Select and copy 48 cells (first 4 cells of each recently created new row)
7. For every other worksheet, specifically excluding the current one, named "Master" and the one named "CALCS" (new loop starting here)
8. Insert 12 new rows at the same position as the top left cell of the newly created block
9. Paste in the contents of the 48 cells copied in step 6

That's it. I hope you can see that this should require simpler and more straightforward code. I am very grateful to Misca for the assistance to date, which did help but could do with now simplifying this, to meet the new, less complex requirements described above.

Thank you for any help.

 

[CiderDrinker]

Further to the above post, this is what I have so far. I know it is not right, but I hope it does give an idea of what I am trying to achieve.

Sub AddStudent()

Dim R As Long
Dim C As Long
Dim Student As String
Dim WS As Worksheet


With ActiveCell
    Student = .Value
    R = .Row
    C = .Column
End With


With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With


' Insert 11 rows below current row (Master sheet)and copy contents of current row to them
    For i = 1 To 11
        ActiveCell.Offset(1, 0).EntireRow.Insert
        ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow
    Next

'Populate months Jan to Dec in column D
    For i = 1 To 12
        ActiveCell.Offset(i, 3).Formula = "=DATE(YEAR(NOW())," & i + 1 & ",1)"
    Next
    
    For Each WS In Worksheets
        If WS.Name <> "CALCS" Then
        With WS.Cells(R, C)
            ' Insert 12 rows and copy contents of same rows on Master sheet to them
            For i = 1 To 12
                ActiveCell.Offset(1, 0).EntireRow.Insert
                ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow
            Next
            End With
        End If
            Next WS


With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With


End Sub