Add text value to adjacent target range via Vlookup macro - vba

Question

Good afternoon, I would like by means of the changed cell value macro function
in Sheet1.Range ("I15:I18") to introduce a text value based on Vlookup function, avoiding using the formula. This is the table that Vlookup function text is looking at:
A B
1 0 Low Risk
2 10 Medium Risk
3 15 High Risk
It follows the code that it doesn't work for me:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim num As Long
Dim sRes As Variant
Set KeyCells = Sheet1.Range("I15:I18")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
sRes = Application.VLookup(num, Sheet2.Range("A56:B58"), 2, True)
Debug.Print sRes
Sheet1.Target.Offset(0, 1).Text = sRes
End If
End Sub
The actual score that falls in the range is triggered by another macro that it works perfectly.
Here also follow the macro that works alright with a single cell:
Sub NumberVLookup()
Dim num As Long
num = 16
Dim sRes As Variant
sRes = Application.VLookup(num, Sheet2.Range("A56:B58"), 2, True)
Debug.Print sRes
Sheet2.Range("J15") = sRes
End Sub
I really appreciate your help in this regard.

Answer 1

Untested:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim sRes As Variant
on error goto haveError
Set rng = Application.Intersect(Me.Range("I15:I18"), Target)
If Not rng Is Nothing Then
If rng.cells.count = 1 then
sRes = Application.VLookup(rng.Value, _
Sheet2.Range("A56:B58"), 2, True)
'turn off events before updating the worksheet
Application.enableEvents = False
rng.Offset(0, 1).Value = IIf(IsError(sRes), "???", sRes)
Select Case rng.Offset(0, 1).Value
Case "Low Risk": rng.Offset(0, 2).Value = Date + 180
Case "Medium Risk": rng.Offset(0, 2).Value = Date + 150
Case "High Risk": rng.Offset(0, 2).Value = Date + 120
End Select
Application.enableEvents = True
End If '<< edit added missing line here
End If
Exit Sub
haveError:
Application.enableEvents = True '<< ensures events are reset
End Sub