I’d like to preface by saying I am a novice to VBA, so hopefully this is an easy fix.

I am trying to get the following VBA code to work for multiple cells with formulas. The effect is that there is a ghost value in the cell a user can overwrite then see again if they delete their value. I can get one cell to work how I want it to, but the second (and third and fourth etc.) do not work. How can I repeat this same line of code so that the effect repeats itself in multiple cells with different formulas?

Working:

```
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Address(False, False) = "F7" Then
If IsEmpty(.Value) Then
Application.EnableEvents = False
.Formula = "=IFERROR(INDEX(DATABASE!$D$2:$AG$3222,MATCH('Pricing Grid'!$B$11,DATABASE!$E$2:$E$3222,0),10),0)"
Application.EnableEvents = True
End If
End If
End With
End Sub
```

My attempt (Top working, bottom not):

```
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Address(False, False) = "F7" Then
If IsEmpty(.Value) Then
Application.EnableEvents = False
.Formula = "=IFERROR(INDEX(DATABASE!$D$2:$AG$3222,MATCH('Pricing Grid'!$B$11,DATABASE!$E$2:$E$3222,0),10),0)"
Application.EnableEvents = True
End If
End If
End With
End Sub
Private Sub Worksheet_Change1(ByVal Target As Excel.Range)
With Target
If .Address(False, False) = "F8" Then
If IsEmpty(.Value) Then
Application.EnableEvents = False
.Formula = "=IFERROR(INDEX(DATABASE!$D$2:$AG$3222,MATCH('Pricing Grid'!$B$11,DATABASE!$E$2:$E$3222,0),9),0)"
Application.EnableEvents = True
End If
End If
End With
End Sub
```

Try this…

```
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, j&, v, t
v = Target.Value2
If Not IsArray(v) Then t = v: ReDim v(1 To 1, 1 To 1): v(1, 1) = t
Application.EnableEvents = False
For i = 1 To UBound(v)
For j = 1 To UBound(v, 2)
If Len(v(i, j)) = 0 Then
With Target(i, j)
Select Case .Address(0, 0)
Case "A1": .Formula = "=""Excel"""
Case "A2": .Formula = "=""Hero"""
End Select
End With
End If
Next
Next
Application.EnableEvents = True
End Sub
```

Use your formulas and ranges instead of mine, of course.

Update

The above works well, but this is faster/better…

```
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, v
DoEvents
ReDim v(1 To 3, 1 To 2)
v(1, 1) = "A1": v(1, 2) = "=""This"""
v(2, 1) = "A2": v(2, 2) = "=""Works"""
v(3, 1) = "A2": v(3, 2) = "=""Great!"""
Application.EnableEvents = False
For i = 1 To UBound(v)
With Range(v(i, 1))
If Not Intersect(Target, .Cells) Is Nothing Then
If Len(.Value2) = 0 Then
.Formula = v(i, 2)
End If
End If
End With
Next
Application.EnableEvents = True
End Sub
```

Both of the above methods work for single-cell deletes AND also for clearing and deleting large ranges, including whole columns and whole rows and the second method is particularly quick in all these scenarios.

### Answer：

You can do something like this:

```
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'only handle single cells
If Target.Cells.CountLarge > 1 Then Exit Sub
If IsError(Target.Value) Then Exit Sub '<< edit: added
'only handle empty cells
If Len(Target.Value) > 0 Or Len(Target.Formula) > 0 Then Exit Sub
On Error Goto haveError
Application.EnableEvents = False
Select Case Target.Address(False, False)
Case "F7": Target.Formula = "=IFERROR(INDEX(DATABASE!$D$2:$AG$3222,MATCH('Pricing Grid'!$B$11,DATABASE!$E$2:$E$3222,0),10),0)"
Case "F8": Target.Formula = "=IFERROR(INDEX(DATABASE!$D$2:$AG$3222,MATCH('Pricing Grid'!$B$11,DATABASE!$E$2:$E$3222,0),9),0)"
End Select
haveError:
'ensure events are re-enabled
Application.EnableEvents = True
End Sub
```

Tags: excelexcel, vba