PDA

View Full Version : whenever auto insert row than auto enter a formula in specific cell



vipulhumein
09-13-2013, 03:07 AM
hello
i have made a sheet with automatic row insertion if column f is less than column h. now i want that whenever the row is inserted than a formula should be entered in the row which is inserted below with formula (column f - column h) of the above row .

Example:-say if i have entered in row 4 of column f value 10 and row 4 of column h value 9 than a row is automatically inserted just below row 4 , now i want that in new row which is inserted just below column 4 say Row 5 is inserted , in that row 5 column f i want a formula that is f4-h4 so that the balance value may come

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Const SALES_PWD = "123"
Dim i As Long
If Target.Column = 8 And Target.Row > 3 Then
If Cells(Target.Row, "K").Value <> 0 Then
If MsgBox("Add new row?", vbYes) Then
Updating = True
ActiveSheet.Unprotect Password:=SALES_PWD
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Insert
Cells(ActiveCell.Row, ActiveCell.Column) = Cells(ActiveCell.Row + 1, ActiveCell.Column) Cells(ActiveCell.Row + 1, ActiveCell.Column) = ""
For i = 1 To 5
Cells(ActiveCell.Row, i).Formula = Cells(ActiveCell.Row - 1, i).Formula
Next i
CopyCells 7
CopyCells 9
CopyCells 10
CopyCells 11
Cells(ActiveCell.Row, 8).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=SALES_PWD
Updating = False
End If
End If
End If
End Sub


Sub CopyCells(ColNum As Long)
Cells(ActiveCell.Row - 1, ColNum).Select
Selection.Copy
Cells(ActiveCell.Row + 1, ColNum).Select
ActiveSheet.Paste
End Sub



thanking you in advance

regards

vipul jain

vipulhumein
09-22-2013, 10:41 AM
i think there is no one in this forum who can help me to solve my problem.
so many people have seen my post but no one is there to help me..

SamT
09-22-2013, 12:52 PM
Is the Active Cell always in column "K"?

And: Is the Active cell always in the new inserted Row?

vipulhumein
09-25-2013, 09:13 PM
HI SAMT
Yah the Active Cell Always in Column K
and the active cell in new inserted row as well as old row

Please solve this as soon as possible its urgent

Thanks
Regards
Vipul Jain

SamT
09-26-2013, 06:36 AM
See if this works for you, It Compiles, but is not otherwise tested.

Private Sub Worksheet_Change(ByVal Target As Range)
Const SALES_PWD = "123"
Dim i As Long
Dim Rw As Long
Dim NewRw As Long
Dim Frmla As String
Dim Cols As Variant

Dim ErrMsg As String
On Error GoTo ErrHandler 'Skip Rest of Sub on Error

'Verify correct Target
ErrMsg = "Error while Verifying Target"
If Intersect(Target, Range("H4:H" & Rows.Count)) Is Nothing Then Exit Sub
If Cells(Target.Row, "K").Value = 0 Then Exit Sub

If Not MsgBox("Add new row?", vbYes) Then Exit Sub

Rw = Target.Row
NewRw =Rw + 1
Frmla = "=F" & Rw & "-H" & Rw

'Load Array with Column #'s of Cells to copy to new Row
Cols = Array(1, 2, 3, 4, 5, 7, 9, 10, 11)

Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:=SALES_PWD

ErrMsg = "Error while Copying Cells"
Rows(NewRw).Insert

'Copy required cells to new Row
For i = 0 To UBound(Cols)
Cells(NewRw, Cols(i)) = Cells(Rw, Cols(i))
Next i

ErrMsg = "Error While adding Formula"
Cells(NewRw, "F").Formula = Frmla
Range("H" & Rw).Select

GoTo GracefulExit 'Skip Error Mssage
ErrHandler:
MsgBox ErrMsg

GracefulExit:
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True, Password:=SALES_PWD
Application.ScreenUpdating = False
End Sub

vipulhumein
09-27-2013, 04:55 AM
hi samt
the code which u have given does not work at all..it only give me msg "add new row" and nothing else..

PLEASE SOLVE
THANKS IN ADVANCE

REGARDS
VIPUL JAIN

SamT
09-27-2013, 05:50 AM
Very obvious mistake, why don't you try to fix it?

Hint: Put cursor in the word "MsgBox" and press F1.

Think "If Not = Then Exit"