Repeating code

[mandeepuppal]

Hi, I am trying to repeat the following code (below) 350 times, is there
an easy way to do it, without copying and pasting.



Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Target.Address(0, 0) = "H2" Then
Application.EnableEvents = False
With Sheets("Utility")
If Target.Value = "Yes" Then
..[I2].Name = "Thelis"
[I2].Value = "N/A"
[J2].Value = "N/A"
Else
..[A1:A5].Name = "Thelis"
[I2].ClearContents
[J2].ClearContents
End If
End With
Application.EnableEvents = True
End If

If Target.Address(0, 0) = "H3" Then
Application.EnableEvents = False
With Sheets("Utility")
If Target.Value = "Yes" Then
..[I3].Name = "Thelis"
[I3].Value = "N/A"
[J3].Value = "N/A"
Else
..[A1:A5].Name = "Thelis"
[I3].ClearContents
[J3].ClearContents
End If
End With
Application.EnableEvents = True
End If

 

[JE McGimpsey]

One way:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim shtUtil As Worksheet
With Target
If .Count > 1 Then Exit Sub
If IsEmpty(.Value) Then Exit Sub
If Not Intersect(.Cells, Range("H2:H351")) Is Nothing Then
Set shtUtil = Sheets("Utility")
If .Value = "Yes" Then
shtUtil.Cells(.Row, 9).Name = "Thelis"
Cells(.Row, 9).Resize(1, 2).Value = "N/A"
Else
shtUtil.Range("A1:A5").Name = "Thelis"
Cells(.Row, 9).Resize(1, 2).ClearContents
End If
End If
End With
End Sub




mandeepuppal