Change Event_Worksheet

G

Gtasios4

Board Regular
Joined
Apr 21, 2022
Messages
80
Office Version
  1. 2021
Platform
  1. Windows
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


1652091892348.png
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Sort by date Sort by votes
try this:
VBA Code: 
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
 
Upvote 0
offthelip said:
try this:
VBA Code: 
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
Click to expand...
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"?
1652096598983.png
 
Upvote 0
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!!)
VBA Code: 
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
 
Upvote 0
offthelip said:
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!!)
VBA Code: 
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
Click to expand...
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

1652259183974.png
 
Upvote 0
You can use virtually the same code as I posted:
VBA Code: 
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
 
Upvote 0
Solution
offthelip said:
You can use virtually the same code as I posted:
VBA Code: 
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
Click to expand...
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
 
Upvote 0
Yes just change thes lines:
VBA Code: 
End With
End If
End Sub
to
VBA Code: 
End With
Else
MsgBox " You must select a cell after row 4 and above the TOTAL"
End If
End Sub
 
Upvote 0
offthelip said:
Yes just change thes lines:
VBA Code: 
End With
End If
End Sub
to
VBA Code: 
End With
Else
MsgBox " You must select a cell after row 4 and above the TOTAL"
End If
End Sub
Click to expand...
Thank you so much for your valuable help!!! Much appreciated
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
VBA Code for User log history
2 3
Replies
21
Views
432
Logit
Logit
K
  • Question Question
Select the Name in the Data Validation list on a cell value then the same name run the sub macro
Replies
9
Views
392
kpmsivaprakasam2003
K
T
  • Solved
Move cursor to a specific cell after data has been entered
Replies
4
Views
215
Peter_SSs
Peter_SSs
H
  • Question Question
VBA Pop Up Message Using Moving Cell Values
Replies
5
Views
335
Joe4
Joe4
S
  • Question Question
Worksheet.Change process
Replies
3
Views
202
Joe4
Joe4

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top