Macro to repeat code on multiple rows

[Frankie81]

Hi I have a Private Sub Macro that I am using currently that works. But I am new to this and need some help extending this.

It currently clears the contents of Cells in the same row in Columns "H" through to "K" when the value in Column "B" is changed. i.e when cell B4 is changed cells H4:K4 are blanked out.

I am looking for a code that will do this from rows 4 to 104 without having to write the code for each row (as in my current code)

the current code I have is this:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range

    For Each Cell In Target
        If Cell.Address = "$B$4" Then
            Application.EnableEvents = False
                Range("H4:J4").ClearContents
            Application.EnableEvents = True
        End If
        
        If Cell.Address = "$B$5" Then
            Application.EnableEvents = False
                Range("H5:J5").ClearContents
            Application.EnableEvents = True
        End If
        
         If Cell.Address = "$B$6" Then
            Application.EnableEvents = False
                Range("H6:J6").ClearContents
            Application.EnableEvents = True
        End If
        
         If Cell.Address = "$B$7" Then
            Application.EnableEvents = False
                Range("H7:J7").ClearContents
            Application.EnableEvents = True
        End If
        
         If Cell.Address = "$B$8" Then
            Application.EnableEvents = False
                Range("H8:J8").ClearContents
            Application.EnableEvents = True
        End If
        
         If Cell.Address = "$B$9" Then
            Application.EnableEvents = False
                Range("H9:J9").ClearContents
            Application.EnableEvents = True
        End If
        
         If Cell.Address = "$B$10" Then
            Application.EnableEvents = False
                Range("H10:J10").ClearContents
            Application.EnableEvents = True
        End If
        
         If Cell.Address = "$B$11" Then
            Application.EnableEvents = False
                Range("H11:J11").ClearContents
            Application.EnableEvents = True
        End If
        
        If Cell.Address = "$B$12" Then
            Application.EnableEvents = False
                Range("H12:J12").ClearContents
            Application.EnableEvents = True
        End If
        
        If Cell.Address = "$B$13" Then
            Application.EnableEvents = False
                Range("H13:J13").ClearContents
            Application.EnableEvents = True
        End If
        
        If Cell.Address = "$B$14" Then
            Application.EnableEvents = False
                Range("H14:J14").ClearContents
            Application.EnableEvents = True
        End If
        
        If Cell.Address = "$B$15" Then
            Application.EnableEvents = False
                Range("H15:J15").ClearContents
            Application.EnableEvents = True
        End If
        
        If Cell.Address = "$B$16" Then
            Application.EnableEvents = False
                Range("H16:J16").ClearContents
            Application.EnableEvents = True
        End If
        
        If Cell.Address = "$B$17" Then
            Application.EnableEvents = False
                Range("H17:J17").ClearContents
            Application.EnableEvents = True
        End If
        
        If Cell.Address = "$B$18" Then
            Application.EnableEvents = False
                Range("H18:J18").ClearContents
            Application.EnableEvents = True
        End If
        
        If Cell.Address = "$B$19" Then
            Application.EnableEvents = False
                Range("H19:J19").ClearContents
            Application.EnableEvents = True
        End If
        
        If Cell.Address = "$B$20" Then
            Application.EnableEvents = False
                Range("H20:J20").ClearContents
            Application.EnableEvents = True
        End If
        
        If Cell.Address = "$B$21" Then
            Application.EnableEvents = False
                Range("H21:J21").ClearContents
            Application.EnableEvents = True
        End If
        
        If Cell.Address = "$B$22" Then
            Application.EnableEvents = False
                Range("H22:J22").ClearContents
            Application.EnableEvents = True
        End If
        
        If Cell.Address = "$B$23" Then
            Application.EnableEvents = False
                Range("H23:J23").ClearContents
            Application.EnableEvents = True
        End If
        
    Next Cell


End Sub

Any Help would be much appreciated.

[karedog]

Hi,

Try this :

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim cell As Range
  For Each cell In Target
      If cell.Column = 2 And cell.Row >= 4 And cell.Row <= 104 Then
         Application.EnableEvents = False
           cell.Offset(, 6).Resize(, 4).ClearContents
         Application.EnableEvents = True
      End If
  Next cell
End Sub

Regards

[Frankie81]

That worked perfectly. Thank you very much.

[protonLeah]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("B4:B104")) Is Nothing Then
        Application.EnableEvents = False
        Target.Offset(0, 6).Resize(columnsize:=3).ClearContents
        Application.EnableEvents = True
    End If

End Sub

[karedog]

You are welcome, thanks for the feedback.


Regards