Copy Down Formulae Row (range of cells) Down to Last Row.

[KayCee]

I am trying to solve a problem that has been bugging me now for days. I have tried other forums and searched numerous web sites but I have not found a suitable solution. The are plenty of suggestions for copy down a formula in one column but not many columns (there are 53 in my spreadsheet). I have attached an image that shows a representation of my 'real' table. I want to copy down the top row of a table containing formulae down to the last row in the table. The table has totals below the last row (column total) and has totals at the last column (row total) Because the user can insert extra rows or delete rows, I need the code to allow for this and so fixed Range values will not work. The new name is obtained from a Form. This is the code I have come up with so far but it relies on a table of a fixed size.

Is there a way of working from the known top left cell of the table, select all the formulae to the right of the first name, and then copy these formula in the top row down to the bottom row?

I have commented out some of my original coding. The remainder is my attempt to use a reference cell that will not change whereas if I used the top-left cell in the table it would move if the name that is added when above the current top name cell.

Option Explicit


Private Sub AddNameButton_Click()


    Dim strName As String
  
 
' Enter a new name


    Sheet2.Select ' Select Meals sheet
    
    Load AddNameForm
    
    strName = Application.Trim(AddNameForm.SURNAME.Value & " " & AddNameForm.Forename.Value)  ' strName dimensioned earlier as a string
    
    If strName = "" Then
        MsgBox ("You did not enter a name")
        Sheet2.Select 'Meals sheet
        Exit Sub
    End If
    
    If AddNameForm.Forename.Value = "" Then
        MsgBox ("You did not enter a Forename")
        Sheet2.Select 'Meals sheet
        Exit Sub
    End If
    
    If AddNameForm.SURNAME.Value = "" Then
        MsgBox ("You did not enter a Surname")
        Sheet2.Select 'Meals sheet
        Exit Sub
    End If
    
    
'Turn off screen updating during next process
    
    Application.ScreenUpdating = False
        
'Select worksheet to input new name and resort in alphabetical order
  
    Sheet2.Select ' Meals sheet
    
    ActiveSheet.Unprotect
    
'Select top name cell in table and create blank row below with same formatting
     
    Range("RefCell1").Offset(2, 0).Activate
'    Range("B9").Activate
    ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown
    ActiveCell.EntireRow.Copy
    ActiveCell.Offset(1).EntireRow.PasteSpecial xlPasteFormats
    
     
'Select blank name cell and insert new name


    Range("RefCell1").Offset(3, 0).Activate
'    Range("B10").Activate
    ActiveCell.Value = strName
    
' Copy formula down for new name entry
    
'
    Range("C9:BF9").Select
    Selection.AutoFill Destination:=Range("C9:BF38"), Type:=xlFillDefault
'    Range("C9:BF38").Select
    Range("A1").Select
    
'Sort name list in alphabetical order
    
    Range("B9").End(xlDown).Select
    Selection.Sort Key1:=Range("B9"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    
    Range("A1").Select
    
    ActiveSheet.Protect
    
    AddNameProgress.Value = 5
   
    Range("A1").Select
    
    ActiveSheet.Protect
    
    Application.ScreenUpdating = True
    
    Unload AddNameForm
    
    MsgBox strName & " was added to all the relevant sheets"
    
End Sub

[Rob342]

Perhaps something like this, you will need to slot the procedure into the correct place on your form also extend the range on the data and rename the sheet ok

Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim IRow As Long
'       Now Do all the Totals on the sheet

Set ws = Worksheets("Sheet1")
           With ws
                 IRow = .Range("A" & Rows.Count).End(xlUp).Row + 1  'this is the last Row +1
                 
                    .Range("B2:B" & IRow).Value = Format(WorksheetFunction.Sum(ws.Range("B2:B" & IRow - 1).Value), "0.00")  'Adds all the total in col B -1
                    .Range("C2:C" & IRow).Value = Format(WorksheetFunction.Sum(ws.Range("C2:C" & IRow - 1).Value), "0.00")
                    .Range("D2:D" & IRow).Value = Format(WorksheetFunction.Sum(ws.Range("D2:D" & IRow - 1).Value), "0.00")
                    .Range("E2:E" & IRow).Value = Format(WorksheetFunction.Sum(ws.Range("E2:E" & IRow - 1).Value), "0.00")
                    .Range("F2:F" & IRow).Value = Format(WorksheetFunction.Sum(ws.Range("F2:F" & IRow - 1).Value), "0.00")
                    .Range("G2:G" & IRow).Value = Format(WorksheetFunction.Sum(ws.Range("G2:G" & IRow - 1).Value), "0.00")
            End With

End Sub

[KayCee]

Thank you for your prompt response. I obviously did not make my request for advice to fix the problem clear (my fault) because the image I provided did not show that the cells in columns C and D had formulae (there are 53 columns in the 'real' spreadsheet).

The way I have set about writing the VBA code is as follows:

1. Set up a form to capture the Forename and Surname
2. Ensure that the form has been completed fully
3. Select the first cell in the first row below the headings
4. Insert a blank row below the first row of data
5. Copy the cells formulae (NOT the name cell) down from the top row to the next row (or the last row).
6. Insert the name in the blank name cell
7. Sort the table alphabetically

I am a novice at VBA coding so please bear with me. I am surprised that in VBA there is not a simple way of doing what I can do easily on the actual spreadsheet: that is, select part of the top row of cells containing formulae and drag down the formulae to the last row of data in the table.

[Rob342]

Ken
Can you post a copy of the workbook
Rob

[Rob342]

Ken
This will copy all the formula's from D1 to Z1 to the last row on the sheet, are there a number of set columns ? you mentioned 53, so you need to amend the last range to suit

Sub Macro3()
'
Dim ws As Worksheet
Dim Irow As Long
Set ws = Worksheets("Sheet1")
With ws
   Irow = .Range("A" & Rows.Count).End(xlUp).Row   'this is the last Row
    .Range("D1:Z1").Copy _
    Destination:=ws.Range("D2:D" & Irow)
End Sub

[KayCee]

Thanks again for responding. I modified the code you provided to fit the 'real' spreadsheet rather than the example shown in the jpg image. The first name in the spreadsheet (Sheet2) is at cell B60 and the last column is at BE60. When I stepped through the code I got a 'Runtime Error 9' 'Sub script out of range' message at the line 'Set ws = Worksheets("Sheet2")'. I would also appreciate your help in ensuring the I have the correct cell references in the subsequent lines. I also got a compiling error about needing an End With statement and so I added that to the code.

Dim ws As Worksheet
Dim Irow As Long
Set ws = Worksheets("Sheet2")
With ws
   Irow = .Range("B" & Rows.Count).End(xlUp).Row   'this is the last Row
    .Range("C60:BE60").Copy _
    Destination:=ws.Range("C60:C" & Irow)
End With

[KayCee]

I am happy to post you a copy of the workbook. It has macros so how do I go about doing so?

[Rob342]

Ken
sorry it missed the "end with" when copying code over, 1 point the set ws=worksheets("Sheet2") refers to the name of the sheet not a cell ref
to post a copy click on reply then go advanced and select the paper clip icon or manage attachments then select your folder & file
Rob

[KayCee]

I did not think it was allowed to upload an excel file containing macros and that is why I resorted to uploading a jpg image or what I was trying to achieve. I have uploaded the workbook so that you can see the extent of the coding needed to achieve a robust method of adding and deleting names from the Meals worksheet.

[Rob342]

Ken
Few questions
How is the userform initiated
are we dealing with the meals sheet
what row do you want what inserted and the formula's created for
Please be specific on what row you want added or inserted and rows for calculations
probably a step by step guide so I know exactly what you are trying to achieve

nb please be aware that if you change a sheet name eg "Sheet2" to "Meals" then that sheet becomes the new name not "Sheet2"


Rob

[KayCee]

The user form will be initiated from a command button "Add Name" on the Meals sheet (I also intend to have a "Delete Name" command button when I have figured out the current problem).

I now realise that having one table above the other may have complicate matters when counting rows and so I have separated the two tables - Meals becomes Meals-Taken and Meals-Costs - and adjusted the formula in the Meals-Costs table accordingly.

I want the top rows of formulae (row 10) in the Meals-Costs copied down (in relative terms) to the row immediately below the top row after the (now) blank row and name has been inserted. I have also changed the VBA code to reflect these changes. However I still get the same error message at the point where you code is run. I have selected worksheets using their sheet number because I am aware that these will not change even if the user changes the tab name for the sheet.

Private Sub AddNameButton_Click()




    Dim strName As String
    Dim ws As Worksheet
    Dim Irow As Long
  
 
' Enter a new name on form
   
    Load AddNameForm
    
    strName = Application.Trim(AddNameForm.SURNAME.Value & " " & AddNameForm.Forename.Value)  ' strName dimensioned earlier as a string
    
    If strName = "" Then
        MsgBox ("You did not enter a name")
        Sheet2.Select 'Meals sheet
        Exit Sub
    End If
    
    If AddNameForm.Forename.Value = "" Then
        MsgBox ("You did not enter a Forename")
        Sheet2.Select 'Meals sheet
        Exit Sub
    End If
    
    If AddNameForm.SURNAME.Value = "" Then
        MsgBox ("You did not enter a Surname")
        Sheet2.Select 'Meals sheet
        Exit Sub
    End If
    
    
'Turn off screen updating during next process
    
    Application.ScreenUpdating = False
        
'Select worksheet to input new name and resort in alphabetical order
  
    Sheet7.Select ' Meals-Taken sheet
    
    ActiveSheet.Unprotect
    
'Select top name cell in Meals-Taken table and create blank row below with same formatting
     
'    Range("RefCell1").Offset(2, 0).Activate
    Range("B10").Activate
    ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown
    ActiveCell.EntireRow.Copy
    ActiveCell.Offset(1).EntireRow.PasteSpecial xlPasteFormats
    
     
'Select blank name cell and insert new name
 


'    Range("RefCell1").Offset(3, 0).Activate
    Range("B11").Activate
    ActiveCell.Value = strName


'Sort top table in alphabetical order
    
    Range("B10").End(xlDown).Select
    Selection.Sort Key1:=Range("B10"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    
'Select top name cell in Meals-Costs table and create blank row below with same formatting
     
    Sheet2.Select ' Meals-Costs sheet
     
'    Range("RefCell1").Offset(2, 0).Activate
    Range("B10").Activate
    ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown
    ActiveCell.EntireRow.Copy
    ActiveCell.Offset(1).EntireRow.PasteSpecial xlPasteFormats
    
     
'Select blank name cell and insert new name


'    Range("RefCell1").Offset(3, 0).Activate
    Range("B11").Activate
    ActiveCell.Value = strName
    
' Copy formula down for new name entry


' ======================================================== Causes error message
Set ws = Worksheets("Sheet2")
With ws
   Irow = .Range("B" & Rows.Count).End(xlUp).Row   'this is the last Row
    .Range("C10:BE39").Copy _
    Destination:=ws.Range("C10:C" & Irow)
End With
'==========================================================
'Sort name list in alphabetical order
    
    Range("B10").End(xlDown).Select
    Selection.Sort Key1:=Range("B10"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    
    Range("A1").Select
    
End Sub

I am aware that this code does not include the names on other sheets but I think I can figure out how to do that if I can get the code working for the Meals-Costs sheet.

I have uploaded the amended spreadsheet.

[Rob342]

Ken
After numerous cups of teat & head scratching have come up with this mod it only works on Meals_Costs sheet but you can work it for the other sheet as req
In VBA if you change sheet names you must use the sheet named as otherwise you will get errors because it cannot find the sheet !!!!
Rob

[KayCee]

Thanks again, however:

At first I thought that had worked and then i checked the formulae that need to reference cells in the Meals-Take worksheet. Both the new name "bbbbb BBBBB" and NAME02 rows ended up with the exactly the same formulae (bbbbb BBBBB has the incorrect reference).

=IF('Meals-Taken'!C12="H",0,IF('Meals-Taken'!C12="N",C$7,IF('Meals-Taken'!C12="M",C$7,IF('Meals-Taken'!C12="M+1",2*C$7,IF('Meals-Taken'!C12="M+2",3*C$7,IF('Meals-Taken'!C12="A",0,IF('Meals-Taken'!C12="","")))))))

The new name row in this case should point to C10 on the Meals-Taken worksheet.

More tea and head scratching?

[Rob342]

Ken
Think I have the solution, have created the line at the end instead of inserting a row at 11 the formula was correct but it was throwing the 1 down out
You will have to match your other meals sheet with this one or go back to the earlier version as you now have to update that sheet as well
Sometimes its quicker to manually do these things than use VBA as your sheet is ever changing there are no set rules for it ?

Have you thought about creating a Multi Userform for this application ?

[KayCee]

Thanks, I will have a go at completing the worksheet code for all the sheets over the weekend and let you know how I got on. I have a good knowledge of using spreadsheets and you are right - I could do all the things I am trying to do without using VBA. However, I want to lock down the workbook in areas where a novice user can create havoc with our club's accounting.

I am not sure how a Multi Userform would work. Is there a link that will explain this to me?

[KayCee]

Thanks again. I must confess I am struggling to understand the code you provided but it did appear to work when I was only adding a name to the Meals-Costs worksheet. I then tried to modify the code so that it would add the name to the Meals-Taken worksheet before adding it to the Meals-Costs worksheet so that there would be a one-to-one relationship between the names on each sheet (and the rows containing the data in the Meals-Taken worksheet. When I ran the code I got an error at the point shown in the attached image. Can you sort this out for me please?

[KayCee]

Sorry, I attached the wrong image (I could not find a way of deleting it). So here is the correct image.

[KayCee]

I appear to have lost contact and so I have repeated my question in the hope I can get assistance on the what appears to be the last part of my problem.  The code provided worked on the Meals-Cost worksheet but when I modified (essentially copied with a change of the worksheet name) it cause an error at the section that I showed in the jpg image above.  I am hoping that a minor change to the code with solve the problem.

I have also attached the modified spreadsheet.

Private Sub AddNameButton_Click()
   
Dim ws As Worksheet
Dim Irow, Nrow As Long
  
Set ws = Worksheets("Name")


' Enter a new name on form


    If Me.Forename.Text = "" Or Me.Forename.Text = " " Then
        MsgBox "You did not enter a Forename", , "Forename Missing"
        Exit Sub
    End If
    
    If Me.SURNAME.Text = "" Or Me.SURNAME.Text = " " Then
        MsgBox "You did not enter a Surname", , "Surname Missing"
        Exit Sub
    End If
      
'Turn off screen updating during next process
    Application.ScreenUpdating = False
    
'If correct forename & surname write it back to the Name sheet for later selection if required
     With ws
        Irow = .Range("A" & Rows.Count).End(xlUp).Row + 1 'Remenber header row then get the last row used
        .Cells(Irow, 1).Value = Me.Forename.Text
        .Cells(Irow, 2).Value = Me.SURNAME.Text
    End With
    
' ===============================================================================  Start of new code
Set ws = Worksheets("Meals-Taken")
    ActiveSheet.Unprotect
'Select top name cell in Meals-Costs sheet and create blank row below with same formatting
     
With ws
    Nrow = .Range("B" & Rows.Count).End(xlUp).Row - 2 'Remenber Lastrow = Totals - blankrow = actual row of last name
    .Rows(Nrow + 1).Select
    Selection.Insert Shift:=xlDown
    .Range("B" & Nrow, "BE" & Nrow).Copy Destination:=.Range("B" & Nrow + 1, "BE" & Nrow + 1)
    
 'Insert full name into sheet can be amended if req
    .Range("B" & Nrow + 1).Value = Me.Forename.Text & " " & Me.SURNAME.Text
 Application.CutCopyMode = False
 End With
     
'clear the sort and redo
    With ws
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=Range( _
        "B10"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    End With
 'Only sorts column B if all fields are sorted then it will copy formula's from that
 'line for example created on line 39 on full sort will have calc for row 39 !!!!!!!!!!
 'You also need to match this sheet with other meals sheet good luck !
 
    With ActiveWorkbook.Worksheets("Meals-Costs").Sort
        .SetRange Range("B10", "B" & Nrow + 2)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With




' ================================================================================  End of new code


Set ws = Worksheets("Meals-Costs")
    ActiveSheet.Unprotect
'Select top name cell in Meals-Costs sheet and create blank row below with same formatting
     
With ws
    Nrow = .Range("B" & Rows.Count).End(xlUp).Row - 2 'Remenber Lastrow = Totals - blankrow = actual row of last name
    .Rows(Nrow + 1).Select
    Selection.Insert Shift:=xlDown
    .Range("B" & Nrow, "BE" & Nrow).Copy Destination:=.Range("B" & Nrow + 1, "BE" & Nrow + 1)
    
 'Insert full name into sheet can be amended if req
    .Range("B" & Nrow + 1).Value = Me.Forename.Text & " " & Me.SURNAME.Text
 Application.CutCopyMode = False
 End With
     
'clear the sort and redo
    With ws
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=Range( _
        "B10"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    End With
 'Only sorts column B if all fields are sorted then it will copy formula's from that
 'line for example created on line 39 on full sort will have calc for row 39 !!!!!!!!!!
 'You also need to match this sheet with other meals sheet good luck !
 
    With ActiveWorkbook.Worksheets("Meals-Costs").Sort
        .SetRange Range("B10", "B" & Nrow + 2)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        
Application.ScreenUpdating = True


'Unload the Userform
 Unload Me
End Sub

[Rob342]

Ken
Do you want to just add the name to the Meals-Taken sheet as the code provided will copy all the formula's in as well, which I don't think you want because the fields are different
In one way you have compounded the problem by separating the sheets, the code will work on previous version with a change of field refs, that way you are only updating 1 sheet not trying to match data with 2 sheets?
Rob

[KayCee]

Rob
You are correct that the Meals-Taken worksheet does not contain formulas but I thought that it would not matter as it would just copy down nothing - so which section of code do I need to remove to just insert a new name and sort it in alphabetical order? There are other worksheets in the workbook that will have names and formulas and so that is why I was keen to use your technique on all worksheets.

As to why I split the Meals-Taken and Meals-Costs worksheets it was because the top-left cell reference (in the vba code) of the bottom table would change when names were added or deleted from the top table.

Many thanks for your continued help and patience.

Oops - just noticed the cell C39 on the Meals-Taken worksheet has the wrong formula after adding a name (it shows row 40 when it should be row 39).