Help in revising VBA code

[Vtookup]

Hi All.
Need help to revise this code.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim DestR As Range
Dim R As Long

If Not Intersect(Target, [A4:A19]) Is Nothing Then

If Target.Count > 1 Then
MsgBox "Select only one cell"
Else
R = 1
Set DestR = Range("B2:C10")
Do Until DestR(R) = "" Or R > DestR.Count
R = R + 1
Loop
If R > DestR.Count Then
MsgBox "You have reached the limit " '& DestR.Address(False, False)
Else
Application.EnableEvents = False
DestR(R).Value = Target.Value
Application.EnableEvents = True
End If
End If
End If
End Sub
now i want Set DestR = Range("B2:C10") to Set DestR = Range("A2")
every time i click anywhere on [A4:A19]
it will replace the content of A2. No more error message.
Also does this allow to extend same function to another range
like [I4:I19] to range("I2")?
Thanks in advance for the help

 

[kevin9999]

I'm basing my response on this bit:

every time i click anywhere on [A4:A19]
it will replace the content of A2. No more error message.
Also does this allow to extend same function to another range
like [I4:I19] to range("I2")?

Please try the following & see if it does what you want:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 And Not Intersect(Me.Range("A4:A19,I4:I19"), Target) Is Nothing Then
        Application.EnableEvents = False
        If Target.Column = 1 Then [A2] = Target
        If Target.Column = 9 Then [I2] = Target
        Application.EnableEvents = True
    End If
End Sub

 

[Vtookup]

Hi Kevin9999.
Big thanks for your code. It work.
Thank You.

​

 

[kevin9999]

Happy to help, and thanks for the feedback