PDA

View Full Version : [SOLVED] Copy Down Formulae Row (range of cells) Down to Last Row.



KayCee
02-19-2019, 08:39 AM
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
02-20-2019, 03:46 AM
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
02-20-2019, 05:38 AM
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
02-20-2019, 06:37 AM
Ken
Can you post a copy of the workbook
Rob

Rob342
02-20-2019, 07:55 AM
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
02-20-2019, 10:31 AM
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
02-20-2019, 10:33 AM
I am happy to post you a copy of the workbook. It has macros so how do I go about doing so?

Rob342
02-20-2019, 02:14 PM
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
02-20-2019, 03:38 PM
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
02-21-2019, 01:28 AM
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
02-21-2019, 03:47 AM
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
02-21-2019, 08:17 AM
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
02-21-2019, 09:57 AM
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
02-22-2019, 05:05 AM
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
02-22-2019, 11:11 AM
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
02-23-2019, 06:28 AM
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
02-23-2019, 06:36 AM
Sorry, I attached the wrong image (I could not find a way of deleting it). So here is the correct image.

KayCee
02-27-2019, 03:50 AM
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
02-27-2019, 05:48 AM
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
02-27-2019, 06:58 AM
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).

Rob342
02-27-2019, 09:30 AM
Hi Ken
Have copied the same routine to meals-Taken as well
Do you want to try it ok
Rob

KayCee
02-27-2019, 09:50 AM
Fantastic! That worked. Do I simply copy and slightly modify the vba code to do the same on the Inc-Exp and Meals Balance worksheets which, like the Meals-Cost worksheet, have formulas to copy down? Thanks for the comments in the vba code which should help me to understand how it is done. Again, many thanks.

Rob342
02-28-2019, 02:49 AM
Ken
Yes you can use the same coding you will have to change the range's, sheet names etc remember last rows are actual data not totals so you will have to compensate for these hence -figure on coding
Can you mark this thread as solved if your happy with it, keeps system clean
You can always post another query if you get stuck ok
Rob

KayCee
02-28-2019, 03:33 AM
Thanks Rob, I believe one final tweak is needed. When I added a name the cell reference in the last row in the Meals-Costs table 'pointed' to Cell 40 - it should be Cell 39 so that it references the correct cell in the Meals-Taken table. Can you help with this before I mark this threat as solved?

Rob342
03-01-2019, 01:23 AM
Ken
The procedure is ok when updating Meals-Cost sheet, but when updating the meals taken sheet it is corrupting the calc why at the moment I do not know
I have separated the update to meals costs and it is ok works fine

I'll get back onto it later today have a few things to do be in touch
Rob

Rob342
03-01-2019, 09:29 AM
Hi Ken
Think I have cured this, have changed the routine so that the Meals-Taken sheet gets updated 1st and then updates the Meals-Costs sheet, I think it was getting confused somewhere trying to copy the calcs on meals-taken, so you need to be aware when doing the other stuff.
Have tried it a few times and now seems to be doing what we want, have attached the latest fix ok
Rob

KayCee
03-03-2019, 07:44 AM
Hi Rob, please accept my apologies for the delay in responding. I downloaded the file and it works! Many, many thanks again for your help and patience in helping me to solve this problem. I will now adapt the vba code to include the remaining worksheets. I will mark this as solved.