Automatically copy formulae to next empty row

[DDawson]

Dear all;

Is there a worksheet change event that will copy all row formulae to the
next five rows when the bottom row is filled with data?

I have a time/ expense billing database on which each row contains a variety
of Vlookups, validated fields, and other formulae. it is approximately 12
rows wide and an increasing number of rows, expanding downwards.

I am trying to reduce the filesize, because I have currently copied the
formulae etc. down 10,000 rows and the filesize is currently 4mb.

Kind regards
Dylan Dawson

 

[Otto Moehrbach]

Dylan
You can use a Worksheet_Change event macro if you have at least one
column that contains data, as opposed to a formula. If all your columns
contain formulas, picking up on which cell changed is a bit more
complicated. Assuming that you do have at least one column with data, you
could code something like the following:
Check if the changed cell is in Column (whatever).
If it is, check if the changed cell is in the last occupied row.
If it is, copy/paste whatever you want.
You might also consider changing (by VBA) all your formulas (in that row) to
values once data has been entered if this fits in with your operation. This
will help in keeping your file from ballooning.
Post back if this seems like what you want. HTH Otto

 

[DDawson]

Dear Otto,

Column I contains date values and column J contains numbers.

The column range i want to copy paste is A:L

I also have four columns containing data validation dropdowns - perhaps I
could reduce these ranges to cover populated rows only, and make them also
increase with data entry.

I would like to keep the formulae for a while, in case the user makes an
error, because they are read/write protected. However it would be an idea if
for example, as a new row is entered the row 10 above is changed to values.

Hope you have a great Christmas!
Kind regards
Dylan

 

[Otto Moehrbach]

Dylan
Yes, I can write the code to put the Data Validations into the new row.
And yes, I can write the code to replace with values the row 10 up.
We (you and I) have to come up with an event to trigger the macro to run.
From what you have said, the event would be the entry of data into one of
the columns (in that last row). That cell must not be one that has a
formula in it. It can be a cell that has Data Validation as well as just a
plain data entry cell. You know your operation. What column?
Otto

 

[Otto Moehrbach]

Daryl
I should have asked you this before - What columns have the Data
Validation cells and what columns have formulas? Otto

 

[DDawson]

Column Format
A Formulae
B Validation
C Formulae
D Validation
E Formulae
F Formulae
G Validation
H Validation
I Data (Blank)
J Data (Blank)
K Formulae
L Formulae

Regards
Dylan

 

[Otto Moehrbach]

Dylan

Try these macros and see if they do what you want. The first
macro is a Worksheet_Change event macro. This macro fires whenever ANY
change is made to the contents of ANY cell in the entire sheet. The code in
that macro says to call the CopyRow macro if the target cell (the cell that
changed) is in Column J and if the target cell is the last occupied cell of
Column J.

The CopyRow macro does the following:

Copies the target row from A to L and pastes it to the following row.

This copied the formulas, data, and Data Validations.

In the new row, it clears the contents of the DV cells but retains the Data
Validation..

In the new row, it clears Columns I & J.

If the target row is greater than 11, the code will do the following to the
row that is 10 rows above the target row:

Removes the Data Validations but not the values.

Removes the formulas but not the values.



Make a copy of your file and try these macros on the copy.

The event macro must be placed in the sheet module of your sheet. You can
access that module by right-clicking on the sheet tab, selecting View Code.
Paste the macro into that module. "X" out of the module to return to your
sheet.

The CopyRow macro goes into a regular module.

If you wish, send me an email and I will send you the small file I used for
this. It has all the code placed properly. My email address is
(e-mail address removed). Remove the "nop" from this address. Otto

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If IsEmpty(Target.Value) Then Exit Sub
If Target.Column = 10 And _
Range("J" & Rows.Count).End(xlUp).Row = Target.Row Then
Call CopyRow(Target.Row)
End If
End Sub



Sub CopyRow(TheRow As Long)
Dim DVRng As Range
Dim DataRng As Range
Set DVRng = Range("B1,D1,G1,H1")
Set DataRng = Range("I1:J1")
Range(Cells(TheRow, 1), Cells(TheRow, 12)).Copy Cells(TheRow + 1, 1)
DVRng.Offset(TheRow).ClearContents
DataRng.Offset(TheRow).ClearContents
If TheRow > 11 Then
TheRow = TheRow - 10
DVRng.Offset(TheRow - 1).Validation.Delete
Range(Cells(TheRow, 1), Cells(TheRow, 12)).Copy
Cells(TheRow, 1).PasteSpecial xlPasteValues
End If
Application.CutCopyMode = False
End Sub

 

[DDawson]

Thanks for that Otto,

One small thing I notice, when a row is copied, the macro copies the border
formatting of Rows B,E,G,H,I and J. This results in having a mixture of these
cells underlined and the others are not. I would prefer to have no
underlining at all.

The vertical lines look fine and I would like to keep them.

I would also note that the Columns B,D,H,I, and J are rows requiring manual
input such as a number or a validation choice.

In terms of the underlining, Column E seems to be the odd one out because it
contains a formulae.

To remedy this I have removed the inderline from the first row, but I would
really like to keep it. Is there anything you can do to fix this?

Kind regards and best wishes for the new year
Dylan Dawson

 

[Otto Moehrbach]

Daryl

Picking and choosing which borders to keep and not keep in the
copy/paste process is cumbersome. I recommend that the code be written to
remove ALL borders in the new row, then apply the borders you want. If you
agree, tell me what borders you want in what cells of the new row. Otto

 

[DDawson]

Hi Otto,

Basically I want to keep the vertical lines which are copied from the header
row and to remove the horizontal lines that are copied from the header row.

So that the only horizontal line is the line below the header row and when
the sheet is printed it will look like this:

|_____|_____|_____|_____|
| | | | |
| | | | |
| | | | |
| | | | |
| | | | |
| | | | |
etc.

Thanks for all your help.
Dylan

 

[Otto Moehrbach]

Daryl
I got pinched for time this morning. This is untested. Try it out.
Otto
Sub CopyRow(TheRow As Long)
Dim DVRng As Range
Dim DataRng As Range
Dim TheRng As Range
Set DVRng = Range("B1,D1,G1,H1")
Set DataRng = Range("I1:J1")
Range(Cells(TheRow, 1), Cells(TheRow, 12)).Copy Cells(TheRow + 1, 1)
DVRng.Offset(TheRow).ClearContents
DataRng.Offset(TheRow).ClearContents
If TheRow > 11 Then
TheRow = TheRow - 10
DVRng.Offset(TheRow - 1).Validation.Delete
Range(Cells(TheRow, 1), Cells(TheRow, 12)).Copy
Cells(TheRow, 1).PasteSpecial xlPasteValues
End If
Set TheRng = Range(Cells(TheRow, 1), Cells(TheRow, 12))
TheRng.Borders.LineStyle = xlNone
With TheRng.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With TheRng.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With TheRng.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Application.CutCopyMode = False
End Sub

 

[DDawson]

Thanks Otto !

Daryl
I got pinched for time this morning. This is untested. Try it out.
Otto
Sub CopyRow(TheRow As Long)
Dim DVRng As Range
Dim DataRng As Range
Dim TheRng As Range
Set DVRng = Range("B1,D1,G1,H1")
Set DataRng = Range("I1:J1")
Range(Cells(TheRow, 1), Cells(TheRow, 12)).Copy Cells(TheRow + 1, 1)
DVRng.Offset(TheRow).ClearContents
DataRng.Offset(TheRow).ClearContents
If TheRow > 11 Then
TheRow = TheRow - 10
DVRng.Offset(TheRow - 1).Validation.Delete
Range(Cells(TheRow, 1), Cells(TheRow, 12)).Copy
Cells(TheRow, 1).PasteSpecial xlPasteValues
End If
Set TheRng = Range(Cells(TheRow, 1), Cells(TheRow, 12))
TheRng.Borders.LineStyle = xlNone
With TheRng.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With TheRng.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With TheRng.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Application.CutCopyMode = False
End Sub