1

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
Cameron Cotton
  • 45
  • 7
  • In addition, can someone suggest a way to incorporate an array formula in the .Formula = "~~~~" section? My attempt that follows throws an error. .ArrayFormula = "=IFERROR(INDEX(DATABASE!$D$2:$AG$3222,MATCH(1,($B$11=DATABASE!$E$2:$E$3222) * (H3=DATABASE!$T$2:$T$3222) * (H4=DATABASE!U2:U3222),0),26),"")" – Cameron Cotton Mar 17 '20 at 06:40
  • What's the logic behind the 10 vs 9 at the end of the formula? – Tim Williams Mar 17 '20 at 06:41
  • Its drawing a different variable from the array of data to display in a different cell on the spreadsheet. – Cameron Cotton Mar 17 '20 at 06:43
  • 1
    Each worksheet only has ONE Worksheet_Change event. You can't add more just by naming a procedure similarly. All of your logic has to be directed from the one event, like Tim's answer demonstrates. – Excel Hero Mar 17 '20 at 06:48
  • also since you are working with `Worksheet_Change` event, [THIS](https://stackoverflow.com/questions/13860894/why-ms-excel-crashes-and-closes-during-worksheet-change-sub-procedure/13861640#13861640) would be worth a read. – Siddharth Rout Mar 17 '20 at 07:37

2 Answers2

1

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
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
  • I think you meant Application.EnableEvents = **True** above the End Sub. – K.Dᴀᴠɪs Mar 17 '20 at 06:54
  • This had the same result as the initial working code. Cell F7 reacted properly, but cell F8 did not. Any suggestions? And thanks for the help! – Cameron Cotton Mar 17 '20 at 07:12
  • The debugger caught this line of code: If Len(Target.Value) > 0 Or Len(Target.Formula) > 0 Then Cell F8 has dollar amounts from $0.00-$10.00 if that means anything – Cameron Cotton Mar 17 '20 at 07:14
  • Added a line to catch error values and exit (you can decide to do something different with those if you want) – Tim Williams Mar 17 '20 at 15:56
1

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.

Excel Hero
  • 14,253
  • 4
  • 33
  • 40