Change Event_Worksheet

[Gtasios4]

Dear All,

I need some help with my below change code event

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Range("B4").Value = "Choose Model"
End If
If Target.Address = "$B$2" Then
Range("B5").Value = "Choose extra part"
End If

End Sub

How the .value = "Choose Extra part" could be changed in the above code so all the inserted rows above the "Total bar" to give the .value = "Choose extra part"

e.g.:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Range("B4").Value = "Choose Model"
End If
If Target.Address = "$B$2" Then
Range("B5" and inserted rows above "total" bar).Value = "Choose extra part"
End If

End Sub

 

[offthelip]

try this:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
    lastrow = Cells(Rows.Count, "N").End(xlUp).Row
    inarr = Range(Cells(1, 14), Cells(lastrow, 14))
    Application.EnableEvents = False   ' turn off events to avoid trigerring the worksheet change event multiple times
    Range("B4").Value = "Choose Model"
    For i = 5 To lastrow
     If inarr(i, 1) <> "TOTAL" Then
      Range(Cells(i, 2), Cells(i, 2)) = "Choose extra part"
     End If
    Next i
End If
Application.EnableEvents = True

End Sub

 

[Gtasios4]

try this:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
    lastrow = Cells(Rows.Count, "N").End(xlUp).Row
    inarr = Range(Cells(1, 14), Cells(lastrow, 14))
    Application.EnableEvents = False   ' turn off events to avoid trigerring the worksheet change event multiple times
    Range("B4").Value = "Choose Model"
    For i = 5 To lastrow
     If inarr(i, 1) <> "TOTAL" Then
      Range(Cells(i, 2), Cells(i, 2)) = "Choose extra part"
     End If
    Next i
End If
Application.EnableEvents = True

End Sub

Dear offthelip,

It works perfectly fine! Thanks a lot.

However, in my tool I have the below vba code attached to 'insert row button" by copying the format/formulas etc. Thus, the above change code event is not filled with the value "choose extra part" when I insert a row (e.g. 6 or 7 etc). Surely, when I am inserting a button and change cell B2 then the value "choose extra part" is then filled out, but should I also change the insertcopy event?

Sub INSERTCOPY()
With ActiveCell.EntireRow
.Copy
.Offset(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
On Error Resume Next
.Offset(1).SpecialCells(xlCellTypeConstants).Value = ""
Application.CutCopyMode = False
On Error GoTo 0
End With
End Sub

Lastly, could you please help me fix the above code to instert copied rows only above the "total bar"?

 

[offthelip]

It is always helpful to have the full picture at the start because you don't need any code in the worksheet change event, so delete all my previous code, I have modified yout sub to do the whole task ( assuming there is yet more you haven't told us!!)

Sub INSERTCOPY()
   lastrow = Cells(Rows.Count, "N").End(xlUp).Row
    inarr = Range(Cells(1, 14), Cells(lastrow, 14))
    For i = 5 To lastrow
     If inarr(i, 1) = "TOTAL" Then
      Exit For
     End If
    Next i
rowno = ActiveCell.Row
If rowno < i Then
With ActiveCell.EntireRow
.Copy
.Offset(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
On Error Resume Next
.Offset(1).SpecialCells(xlCellTypeConstants).Value = ""
Application.CutCopyMode = False
On Error GoTo 0
End With
Range(Cells(rowno + 1, 2), Cells(rowno + 1, 2)) = "Choose extra part"
Else
MsgBox " You must select a cell above the TOTAL"
End If
End Sub

 

[Gtasios4]

It is always helpful to have the full picture at the start because you don't need any code in the worksheet change event, so delete all my previous code, I have modified yout sub to do the whole task ( assuming there is yet more you haven't told us!!)

Sub INSERTCOPY()
   lastrow = Cells(Rows.Count, "N").End(xlUp).Row
    inarr = Range(Cells(1, 14), Cells(lastrow, 14))
    For i = 5 To lastrow
     If inarr(i, 1) = "TOTAL" Then
      Exit For
     End If
    Next i
rowno = ActiveCell.Row
If rowno < i Then
With ActiveCell.EntireRow
.Copy
.Offset(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
On Error Resume Next
.Offset(1).SpecialCells(xlCellTypeConstants).Value = ""
Application.CutCopyMode = False
On Error GoTo 0
End With
Range(Cells(rowno + 1, 2), Cells(rowno + 1, 2)) = "Choose extra part"
Else
MsgBox " You must select a cell above the TOTAL"
End If
End Sub

Dear Offthelip,

I've tried the above-proposed code which is really helpful especially with the msgbox, however in my tool I need the change event code because cells B4, B5 have depended drop down list based on cell B2. Therefore, If the user changes the brand from cell B2, then B4,B5 should change and not keep the previous values.

This code that you proposed me is the best option towards to what I want to do and I am really grateful.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
lastrow = Cells(Rows.Count, "N").End(xlUp).Row
inarr = Range(Cells(1, 14), Cells(lastrow, 14))
Application.EnableEvents = False ' turn off events to avoid trigerring the worksheet change event multiple times
Range("B4").Value = "Choose Model"
For i = 5 To lastrow
If inarr(i, 1) <> "TOTAL" Then
Range(Cells(i, 2), Cells(i, 2)) = "Choose extra part"
End If
Next i
End If
Application.EnableEvents = True

End Sub

I was just wondering for the below code IF the copy row (5) could be inserted somehow under row 5 and above the bar "TOTAL:" as well as every row that the user wants to add to be inserted above the "total bar". If that helps I want only row 5 and its formulas, format to be copied in the inserted rows.

Sub INSERTCOPY()
With ActiveCell.EntireRow
.Copy
.Offset(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
On Error Resume Next
.Offset(1).SpecialCells(xlCellTypeConstants).Value = ""
Application.CutCopyMode = False
On Error GoTo 0
End With
End Sub

 

[offthelip]

You can use virtually the same code as I posted:

Sub INSERTCOPY()
   lastrow = Cells(Rows.Count, "N").End(xlUp).Row
    inarr = Range(Cells(1, 14), Cells(lastrow, 14))
    For i = 5 To lastrow
     If inarr(i, 1) = "TOTAL" Then
      Exit For
     End If
    Next i
rowno = ActiveCell.Row
If rowno < i And rowno > 4 Then
With ActiveCell.EntireRow
.Copy
.Offset(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
On Error Resume Next
.Offset(1).SpecialCells(xlCellTypeConstants).Value = ""
Application.CutCopyMode = False
On Error GoTo 0
End With
End If
End Sub

 

[Gtasios4]

You can use virtually the same code as I posted:

Sub INSERTCOPY()
   lastrow = Cells(Rows.Count, "N").End(xlUp).Row
    inarr = Range(Cells(1, 14), Cells(lastrow, 14))
    For i = 5 To lastrow
     If inarr(i, 1) = "TOTAL" Then
      Exit For
     End If
    Next i
rowno = ActiveCell.Row
If rowno < i And rowno > 4 Then
With ActiveCell.EntireRow
.Copy
.Offset(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
On Error Resume Next
.Offset(1).SpecialCells(xlCellTypeConstants).Value = ""
Application.CutCopyMode = False
On Error GoTo 0
End With
End If
End Sub

Dear Offthelip,

It works perfect!!! I have to questions on that code:

1) Can I also put a msg box at the end of the code so as the user to select a cell above the "total bar" so as to insert the copied row? so as to direct the user somehow..

Like?
Sub INSERTCOPY()
lastrow = Cells(Rows.Count, "N").End(xlUp).Row
inarr = Range(Cells(1, 14), Cells(lastrow, 14))
For i = 5 To lastrow
If inarr(i, 1) = "TOTAL" Then
Exit For
End If
Next i
rowno = ActiveCell.Row
If rowno < i And rowno > 4 Then
With ActiveCell.EntireRow
.Copy
.Offset(1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
On Error Resume Next
.Offset(1).SpecialCells(xlCellTypeConstants).Value = ""
Application.CutCopyMode = False
On Error GoTo 0
End With
End If
Else
MsgBox " You must select a cell above the TOTAL"
End Sub

2) Since I have the change event code which runs perfectly in parallel with the insertcopy code, is it possible to take the value "Choose extra part" in the inserted row, no matter the cell B2 is changed?

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Range("B4").Value = "Choose Model"
End If
If Target.Address = "$B$2" Then
Range("B5").Value = "Choose extra part"
End If

End Sub

 

[Fluff]

@Gtasios4 when posting code code please use code tags, rather than making everything bold How to Post Your VBA Code

 

[offthelip]

Yes just change thes lines:

End With
End If
End Sub

to

End With
Else
MsgBox " You must select a cell after row 4 and above the TOTAL"
End If
End Sub

 

[Gtasios4]

Yes just change thes lines:

End With
End If
End Sub

to

End With
Else
MsgBox " You must select a cell after row 4 and above the TOTAL"
End If
End Sub

Thank you so much for your valuable help!!! Much appreciated