Solved: vba auto row insert and revert back

[vipulhumein]

Is there anyone who can help me. no one is replying
I made a workbook in which Sheet named "Dispatch & FG" . so in this sheet Column T had a drop down for "accepted" and "rejected" now i want that if anyone selected from drop down "rejected" than auto row should be inserted below with formula but if afterwards someone change the cell from "rejected" to "accepted" than the row which is auto inserted just below that row should be deleted.


please help me somone

for your ready reference i have made some vba which is as follows please recftify:
Private Sub Worksheet_Change(ByVal Target As Range)
Const Disp_PWD = "123"
Dim i As Long

If Target.Column = 20 And Target.Row > 5 And Not Updating Then
If Target = "Rejected" Then

ActiveSheet.Unprotect Password:=Disp_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:=Disp_PWD
Updating = False
End If
End If
If OLDVALUE = "Rejected" Then
If Target = "Accepted" Then
Rows(Target.Row & ":" & Target.Row).Delete
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


Thanks in advance

Regards
Vipul

[rollis13]

Got it somehow to work, not very elegant though, just to keep you going.
You need to have a (hidden) help-column U (21).
Then you also will have to workout your protection.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const Disp_PWD = "123"
Dim i As Long
If Target.Count > 1 Then Exit Sub '<== added
If Target.Column = 20 And Target.Row > 5 Then '<== changed
If Cells(ActiveCell.Row, ActiveCell.Column + 1) <> ActiveCell.Value Then '<== changed
ActiveSheet.Unprotect Password:=Disp_PWD '<== moved
Application.EnableEvents = False '<== added
If Target = "Rejected" Then
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
'Updating = False '<== not used
End If
If Target = "Accepted" And Cells(ActiveCell.Row, ActiveCell.Column + 1) <> "" Then '<== changed
Rows(Target.Row & ":" & Target.Row).Delete
End If
Cells(ActiveCell.Row, ActiveCell.Column + 1) = ActiveCell.Value '<== added
Application.EnableEvents = True '<== added
'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=Disp_PWD '<== moved
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
Application.CutCopyMode = False '<== added
End Sub

[vipulhumein]

hello Rollis
Thanks for replying.
the code which u have given working in wrong direction .. i.e the auto row is inserted above i want the auto row should be inserted below and also as u have told the column U should be help column is it possible that column AG is the help column as column U have some data and is also linked to other sheet

so please rectify the code

Thanks

Regards
Vipul Jain

[vipulhumein]

hello Rollis
Thanks for replying.
the code which u have given working in wrong direction .. i.e the auto row is inserted above i want the auto row should be inserted below and also as u have told the column U should be help column is it possible that column AG is the help column as column U have some data and is also linked to other sheet

so please rectify the code

Thanks

Regards
Vipul Jain

[rollis13]

To change the help column (AG=33), wherever you see "ActiveCell.Column + 1" change to "ActiveCell.Column + 13" (3 cases).

As for the macro working in the wrong direction this is how you originally coded it. No changes have been done to the central part of the code that does the job. You will have to work on it.

[vipulhumein]

yah i have given the code but i know he code is not running as per the requirement thats why i posted here ...if its possible please solve the query...
please solve this also..
1. the row should be inserted below

thanks

[rollis13]

To have the row inserted below just change the line "Rows(ActiveCell.Row & ":" & ActiveCell.Row).Insert" to "Rows(ActiveCell.Row + 1 & ":" & ActiveCell.Row + 1).Insert".

Attaching an example sheet would be useful for anyone who would like to help. It should also show the sheet before and after an added row with application of "Rejected" and information from where and what data has to be copied to the new row.

[vipulhumein]

hi rollis i dont know what happen why it is not working properly
but for ur ready reference please see the file which i have attached and made the needful thanks. so that it can run as per the requirement

[vipulhumein]

file attached

[rollis13]

Sorry, your attachment does not corrispond to your proposed macro.
The target column 20 (T) in the macro doesn't match with your sheet, it should be column 21 (U) since there is a hidden column K.

And you did not provided information about which cells have to be copied to the new row. These are needed because your macro doesn't match the sheet layout and the information has to be reconstructed.

There could be another problem, I use the elder Excel 2003.

[vipulhumein]

hello rollis good morning
yah i have changed the target column to 21 because i have inserted one more column and i want whenever the new row inserted below than the above row formula should be copied (wherever there is formula) and the manual data should not be copied below. the cell to be copied below i have already mentioned in the vba.

thank for the quick feedback

Regards
vipul jain

[rollis13]

Have a try on a test sheet with this new code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Const Disp_PWD = "123"
Dim i As Long
If Target.Count > 1 Then Exit Sub
If Target.Column = 21 And Target.Row > 5 Then
If Cells(ActiveCell.Row, ActiveCell.Column + 13) <> ActiveCell.Value Then
ActiveSheet.Unprotect Password:=Disp_PWD
Application.EnableEvents = False
If Target = "Rejected" Then
Rows(Target.Row + 1).EntireRow.Insert 'insert row below
Rows(Target.Row).Copy 'copy active row
Rows(Target.Row + 1).PasteSpecial xlPasteFormulas 'paste below only formulas
Cells(ActiveCell.Row, Target.Column) = "" 'clear drop down cell
Cells(ActiveCell.Row - 1, 21).Select
End If
If Target = "Accepted" And Cells(ActiveCell.Row, Target.Column + 13) <> "" Then
Rows(Target.Row + 1).EntireRow.Delete
End If
Cells(ActiveCell.Row, ActiveCell.Column + 13) = ActiveCell.Value 'update help-cell
Application.CutCopyMode = False
Application.EnableEvents = True
'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=Disp_PWD
End If
End If
End Sub

[vipulhumein]

hello rollis
since now the code works but again the problem the code not only insert the formula below but also without formula data i.e u have seen in my test sheet the column in gray are formulas column and column in white are manual data column.
so the code should insert row below with only formulas column but the column which is in white should be inserted blank...means only formulas column should be paste below the row not the manual data column..

thanks

regards
vipul jain

[rollis13]

Added clearing non formula cells:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Const Disp_PWD = "123"
Dim acr As Long
If Target.Count > 1 Then Exit Sub
If Target.Column = 21 And Target.Row > 5 Then
If Cells(ActiveCell.Row, ActiveCell.Column + 13) <> ActiveCell.Value Then
ActiveSheet.Unprotect Password:=Disp_PWD
Application.EnableEvents = False
If Target = "Rejected" Then
Rows(Target.Row + 1).EntireRow.Insert
Rows(Target.Row).Copy
Rows(Target.Row + 1).PasteSpecial 'Paste:=xlPasteFormulas
acr = ActiveCell.Row
'clear non formula ranges
Range("N" & acr & ":" & "Q" & acr).ClearContents
Range("S" & acr).ClearContents
Range("U" & acr & ":" & "W" & acr).ClearContents
Range("AD" & acr).ClearContents
Range("AF" & acr).ClearContents
Cells(acr - 1, 21).Select
End If
If Target = "Accepted" And Cells(ActiveCell.Row, Target.Column + 13) <> "" Then
Rows(Target.Row + 1).EntireRow.Delete
End If
Cells(ActiveCell.Row, ActiveCell.Column + 13) = ActiveCell.Value
Application.CutCopyMode = False
Application.EnableEvents = True
'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=Disp_PWD
End If
End If
End Sub

[rollis13]

Even with less script lines:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const Disp_PWD = "123"
Dim TR As Long
If Target.Count > 1 Then Exit Sub
If Target.Column = 21 And Target.Row > 5 Then
TR = Target.Row
If Cells(TR, Target.Column + 13) <> ActiveCell.Value Then
ActiveSheet.Unprotect Password:=Disp_PWD
Application.EnableEvents = False
If Target = "Rejected" Then
Rows(TR + 1).EntireRow.Insert
Rows(TR).Copy
Rows(TR + 1).PasteSpecial Paste:=xlPasteFormulas
Rows(TR + 1).SpecialCells(xlCellTypeConstants).ClearContents
Cells(TR, 21).Select
End If
If Target = "Accepted" And Cells(TR, Target.Column + 13) <> "" Then
Rows(TR + 1).EntireRow.Delete
End If
Cells(TR, Target.Column + 13) = Target.Value
Application.CutCopyMode = False
Application.EnableEvents = True
'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=Disp_PWD
End If
End If
End Sub

[vipulhumein]

hello rollis
thanks again for the feedback but as i told before when the auto row is inserted the the above formulas to be copied below as it is.
Means if for example in row 6 formula in column D is A6+B6 then the row which is to be inserted if rejected in row 6 than the formula be in column D should be A6+B6...
please see my first post the formula which is to be copied below


thanks waiting for your quick reply

[vipulhumein]

hello Rollis
please see the attachment which i have given before....
In that sheet u will find there are some column in which the cell are linked with other sheet... so i want that the column which are linked with other sheet should be copied as above that should not be vary with row.

Thanks

Regards
vipul jain

[rollis13]

I slowly get to understand what your goal is, try this:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const Disp_PWD = "123"
Dim TR As Long
Dim i As Long

If Target.Count > 1 Then Exit Sub
If Target.Column = 21 And Target.Row > 5 Then
TR = Target.Row
If Cells(TR, Target.Column + 13) <> ActiveCell.Value Then
ActiveSheet.Unprotect Password:=Disp_PWD
Application.EnableEvents = False
If Target = "Rejected" Then
Rows(TR + 1).EntireRow.Insert 'insert row below
For i = 1 To 32 'copy all cells to new row
Cells(TR + 1, i).Formula = Cells(TR, i).Formula
Next i
Rows(TR + 1).SpecialCells(xlCellTypeConstants).ClearContents 'clear non formula in new row
End If
If Target = "Accepted" And Cells(TR, Target.Column + 13) <> "" Then
Rows(TR + 1).EntireRow.Delete 'delete row below
End If
Cells(TR, Target.Column + 13) = Target.Value 'update help-column
Application.CutCopyMode = False
Application.EnableEvents = True
'ActiveSheet.Protect Password:=Disp_PWD '<== to be enabled after testing
End If
End If
End Sub

[vipulhumein]

thanks rollis for the help and also for your quick response
heads off to you rollis,
and also thanks for not irritated by my questions
whenever i need help how can i contact u directly...
as previously i have asked many question but no one answer me

thank u very much


Regards
Vipul jain

[rollis13]

Glad I was of help :content:. Thank you the confidence, but since this is a free forum where should prevail team spirit, I suggest you post always directly in the forum.

[vipulhumein]

ok thanks