Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Me.[D4:D9].FormulaR1C1 = "=1/(RC1<>"""")"
On Error Resume Next
Intersect(Me.[B4:B9], Me.[D4:D9].SpecialCells( _
xlCellTypeFormulas, 1).EntireRow).FormulaR1C1 = "=RC3"
Me.[D4:D9].ClearContents
Application.EnableEvents = True
End Sub