Insert row
The solution isn't to move the total row because if you insert a row the
formula will Change automatically. except if you add a row immediately before
the total row. The solution is to change this line slightly to handle a
different amount of row in the data
from
If target.Row < 6 Then Exit Sub 'starting row following hidden formula row
to
LastRow = Range("A" & Rows.count).end(xlup).row
If target.Row < (LastRow - 1) Then Exit Sub 'starting row following
hidden
'formula
row
I made the code work with any added Rows between row 2 and the hidden row
which I assume is the last row
Private Sub Worksheet_Change(ByVal target As Range)
If target.Row = 1 Then Exit Sub
If target.Cells.Count 1 Then Exit Sub
If target.Column < 5 Then Exit Sub 'last data entry cell
LASTROW = Range("F" & Rows.Count).End(xlUp).Row
If target.Row LASTROW Then Exit Sub 'starting row following hidden
formula row
If target.Offset(0, 1).Value < "" Then
Response = MsgBox("You are overwrititng existing data. " & _
Are you sure?", vbYesNo)
If Response = vbNo Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
End If
Application.EnableEvents = False
'MsgBox "Range" & target.Address & "was changed"
Range("F" & LASTROW).Copy _
Destination:=Range("F2:F" & LASTROW) 'formula row to copy
Application.EnableEvents = True
End Sub
"Jim G" wrote:
I have a template that copies fromulas from a hidden row after an entry in
col A and moves the curser down to the next line. This means I don't need to
know how many lines are required to complete the data entry. However I have
added a total line below the data entry line.
I want to modify the following code (kindly provided by Bernie Deitrick) to
insert a row to move the total line down so as the new data line follows the
one above.
Private Sub Worksheet_Change(ByVal target As Range)
If target.Cells.Count 1 Then Exit Sub
If target.Column < 5 Then Exit Sub 'last data entry cell
If target.Row < 6 Then Exit Sub 'starting row following hidden formula row
If target.Offset(0, 1).Value < "" Then
If MsgBox("You are overwrititng existing data. Are you sure?", vbYesNo) =
vbNo Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
End If
Application.EnableEvents = False
Cells(target.Row + 1, 1).Select
'MsgBox "Range" & target.Address & "was changed"
Range("F5:Q5").Copy target.Offset(0, 1).Resize(1, 12) 'formula row to copy
Application.EnableEvents = True
End Sub
--
Jim
|