• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

please help me to run this code

vipulhumein

New Member
[pre]
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
[/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..
 
Back
Top