How to repeat an If Change Code in multiple descending rows in a worksheet?

greggmorgangolf

New Member
Joined
Jul 4, 2023
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Hi,

I have written a relatively simple IF code to reset my dropdown lists in the top row of my data if the depentent cell value changes.

I want to repeat this code for a range (columns C to L) of rows in the worksheet (2000 or so). I am hoping this is relatively simple? Could anyone help please?

Code below:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$C$4" Then
Range("D4:L4").Value = "Select..."
End If
If Target.Address = "$D$4" Then
Range("E4:L4").Value = "Select..."
End If
If Target.Address = "$E$4" Then
Range("F4:L4").Value = "Select..."
End If
If Target.Address = "$F$4" Then
Range("G4:L4").Value = "Select..."
End If
If Target.Address = "$G$4" Then
Range("H4:L4").Value = "Select..."
End If
If Target.Address = "$H$4" Then
Range("I4:L4").Value = "Select..."
End If
If Target.Address = "$I$4" Then
Range("J4:L4").Value = "Select..."
End If
If Target.Address = "$J$4" Then
Range("L4").Value = "Select..."
End If

End Sub

Screenshot below of cells I want the code to repeat on based on the same logic in row 4. (Columns C to L are the range)

1688469481748.png
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
@greggmorgangolf Welcome.
If I am understanding correctly then maybe like below?

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Col As Integer
Dim Rw As Integer
If Intersect(Target, Range("C4:K2500")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub

Rw = Target.Row
Col = Target.Column

Range(Cells(Rw, Col), Cells(Rw, 12)) = "Select..."

End Sub
 
Upvote 0
Apologies above is obviously no good as it overwrites the Target cell.
See if this helps.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Col As Integer
Dim Rw As Integer
If Intersect(Target, Range("C4:K2500")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub

Rw = Target.Row
Col = Target.Column + 1

Application.EnableEvents = False
If Col <= 11 Then Range(Cells(Rw, Col), Cells(Rw, 12)) = "Select..."
Application.EnableEvents = True
End Sub
 
Upvote 0
You sir are a gentleman & a scholar. This has worked perfectly. Thank you very much. 🙏
Now I need to read through it properly to understand the logic. :ROFLMAO:(y)
 
Upvote 0
Great to hear! You are most welcome.
Below may help you understand code.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Col As Integer
Dim Rw As Integer
'If the Target cell is not in myrange of interest then ignore
If Intersect(Target, Range("C4:K2500")) Is Nothing Then Exit Sub
'If more than1 cell is changed eg via a copy paste then ignore
If Target.Cells.Count > 1 Then Exit Sub
'get the target row
Rw = Target.Row
' get the column number for the column right of target
Col = Target.Column + 1
'disable event handling so that changes made by this event code do bot cause
'it to call itself and create a infinite loop
'Probably unnecessary when thebelow changes more than1 cell!?
Application.EnableEvents = False
'if target column is C : K then fill to right as far as L
'therefore, gnore if target col is L
If Col <= 11 Then Range(Cells(Rw, Col), Cells(Rw, 12)) = "Select..."
'Reestablish event handling
Application.EnableEvents = True
End Sub
 
Upvote 0
Solution
That was extremely helpful. Thank you.

I have added an iferror(vlookup for columns H, J, and L to automate the tracker data entry where possible.

I am wondering if there is a way of removing the data if a dependent cell to the left is changed in the same way without removing/overwriting my iferror(vlookup formula in cells H, J and L which will be hidden from users when the sheet is protected?

Visual of senario below.

1689874640894.png
 
Upvote 0
Again if I understand correctly then maybe as below.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Integer
Dim Col As Integer
Dim Rw As Integer
'If the Target cell is not in myrange of interest then ignore
If Intersect(Target, Range("C4:K2500")) Is Nothing Then Exit Sub
'If more than1 cell is changed eg via a copy paste then ignore
If Target.Cells.Count > 1 Then Exit Sub
'get the target row
Rw = Target.Row
' get the column number for the column right of target
Col = Target.Column + 1
'disable event handling so that changes made by this event code do bot cause
'it to call itself and create a infinite loop
'Probably unnecessary when thebelow changes more than1 cell!?
Application.EnableEvents = False
'if target column is C : K then fill to right as far as L
'cols H J L are hidden with formula so ignore

For c = Col To 11
    Select Case c
        Case 8, 10   'cols H J
        'do nothing
        Case Else  'Otherwise
         Cells(Rw, c) = "Select..."
    End Select
Next c

'Re-establish event handling
Application.EnableEvents = True
End Sub
 
Upvote 0
Again if I understand correctly then maybe as below.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Integer
Dim Col As Integer
Dim Rw As Integer
'If the Target cell is not in myrange of interest then ignore
If Intersect(Target, Range("C4:K2500")) Is Nothing Then Exit Sub
'If more than1 cell is changed eg via a copy paste then ignore
If Target.Cells.Count > 1 Then Exit Sub
'get the target row
Rw = Target.Row
' get the column number for the column right of target
Col = Target.Column + 1
'disable event handling so that changes made by this event code do bot cause
'it to call itself and create a infinite loop
'Probably unnecessary when thebelow changes more than1 cell!?
Application.EnableEvents = False
'if target column is C : K then fill to right as far as L
'cols H J L are hidden with formula so ignore

For c = Col To 11
    Select Case c
        Case 8, 10   'cols H J
        'do nothing
        Case Else  'Otherwise
         Cells(Rw, c) = "Select..."
    End Select
Next c

'Re-establish event handling
Application.EnableEvents = True
End Sub
This has worked perfectly. Thank you very much.
And I very much appreciate the time taken to describe the code actions. This is excellent for helping me to understand the coding methods.
Have a great evening and tanks again.
 
Upvote 0

Forum statistics

Threads
1,215,079
Messages
6,123,009
Members
449,093
Latest member
ikke

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