vipulhumein
New Member
[pre]
[/pre]
The above code runs wrongfully i want that if in the target column any cell having text "rejected" than auto insert row below that with formula.
Please rectify the above code and send me as soon as possible..
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Const Prod_PWD = "123"
Dim i As Long
If Target.Column = 20 And Target.Row > 5 And Not Updating Then
If MsgBox("Add new row?", vbYesNo, "Change Sheet") = vbYes Then
Updating = True
ActiveSheet.Unprotect Password:=Prod_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 12
Cells(ActiveCell.Row, i).Formula = Cells(ActiveCell.Row - 1, i).Formula
Next i
CopyCells 17
CopyCells 19
CopyCells 25
CopyCells 26
CopyCells 27
CopyCells 28
CopyCells 29
CopyCells 30
CopyCells 32
Cells(ActiveCell.Row, 20).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=Prod_PWD
Updating = False
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
The above code runs wrongfully i want that if in the target column any cell having text "rejected" than auto insert row below that with formula.
Please rectify the above code and send me as soon as possible..