Data validation list and Vlookup in VBA, to input, on cell change, if/vlookup formula referencing cell that was changed

[leftikos]

Dear Excel Guru’s

I’m struggling with one of my last tryouts in Excel Macros.
I would like to have in my sheet combination of Data validation list & Vlookup. But I want to have it in Macro, so user won’t be able to see formulas, delete, edit etc..
I succeed with stand-alone Macro (what was easy), but my intention is have real-time as with formulas. I’ve used Private Sub Worksheet_Change(ByVal Target As Range).
I keep receiving errors “Object doesn’t support this property or method”. I guess the reason might be multi-trigger 1) Private Sub Worksheet_Change 2) rest of code…

Please check the attachment to make clear what am I trying for.
There is working macro: Sub MacroVlookup()
and then Private Sub Worksheet_Change(ByVal Target As Range) in Sheet1 which is not working.

https://drive.google.com/file/d/0B0s-0_lS3QrnMHZPZnlHd3lDRzg/view?usp=sharing

Thanks for your help.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rCell As Range
    Dim rRng1 As Range
    Dim rRng2 As Range
    
    Set rRng2 = Sheets("Data").Range("C2:F6")

    On Error GoTo haveError

    'see if any changes are in the monitored range...
    Set rRng1 = Application.Intersect(Target, Me.Range("C1:C10"))


    If Not rRng1 Is Nothing Then
    'Next line prevents code updates from re-triggering this...
    
    Application.EnableEvents = False
    
    For Each rCell In rRng1.rCells
    Debug.Print rCell.Address, rCell.Value
        If rCell.Value <> "" Then
        
        rCell.Offset(0, 1) = Application.VLookup(rCell, rRng2, 2, 0)
        rCell.Offset(0, 2) = Application.VLookup(rCell, rRng2, 3, 0)
        rCell.Offset(0, 3) = Application.VLookup(rCell, rRng2, 4, 0)
       
        End If
    Next
    Application.EnableEvents = True

    End If


    Exit Sub

 

[steve the fish]

Change this line: For Each rCell In rRng1.rCells to For Each rCell In rRng1.Cells

 

[steve the fish]

You can just use: For Each rCell In rRng1 if you want

 

[leftikos]

Hi steve the fish,
thanks for your quick respond and excellent help, its working.

If I may have second question, it would be awesome help for me.

I've improved my macro little bit, so it's removing the data from 3 columns if cell from data validation column is removed. I've added lines to keep cells blank if there is manual input in data validation column.

But I would like to add 2 or more columns working same way with other data validation.

See below, first which has been done belongs to Name variables, second is Team. I've tried several options, but I've always managed to work only one.

https://drive.google.com/file/d/0B0s-0_lS3QrnaUlyZ2VFNzE4Vzg/view?usp=sharing

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rName As Range
    Dim rNameSource As Range
    Dim rNameInput As Range
    Dim vID As Variant
    Dim vEMAIL As Variant
    Dim vADR As Variant
        Dim rTeam As Range
        Dim rTeamSource As Range
        Dim rTeamInput As Range
        Dim vNUM As Variant
    
    Set rNameInput = Sheets("Data").Range("C2:F1000")
    Set rTeamInput = Sheets("Data").Range("A2:A1000")


    On Error GoTo haveError


    'see if any changes are in the monitored range...
    Set rNameSource = Application.Intersect(Target, Me.Range("C:C"))
    'Set rTeamSource = Application.Intersect(Target, Me.Range("A:A"))


    If Not rNameSource Is Nothing Then
    'If Not rTeamSource Is Nothing Then
    'Next line prevents code updates from re-triggering this...
    
    Application.EnableEvents = False
    
    For Each rName In rNameSource.Cells
   ' For Each rTeam In rNameSource.Cells
    Debug.Print rName.Address, rName.Value
    'Debug.Print rTeam.Address, rTeam.Value
        If rName.Value <> "" Then
        'If rTeam.Value <> "" Then
            vID = Application.VLookup(rName, rNameInput, 2, 0)
            vEMAIL = Application.VLookup(rName, rNameInput, 3, 0)
            vADR = Application.VLookup(rName, rNameInput, 4, 0)
            'vNUM = Application.VLookup(rTeam, rTeamInput, 2, 0)
            
    'Add blank if #N/A
            If IsError(vID) Then
                rName.Offset(0, 1) = ""
                rName.Offset(0, 2) = ""
                rName.Offset(0, 3) = ""
            Else
                rName.Offset(0, 1) = vID
                rName.Offset(0, 2) = vEMAIL
                rName.Offset(0, 3) = vADR
            End If
        End If
    
    'remove field when selection from data validation list is removed
            If rName.Value = "" Then
                rName.Offset(0, 1) = ""
                rName.Offset(0, 2) = ""
                rName.Offset(0, 3) = ""
            End If
    Next
    Application.EnableEvents = True


    End If
    
    Exit Sub


haveError:
    MsgBox Err.Description
    Application.EnableEvents = True


End Sub