Excel Check Vlookup value if cell value matches

[Jyotirmaya]

I have two Sheets "DATA" "RAW DATA"

In DATA sheets

Column A COLUMN B
APPLE 10
APPLE 15
APPLE 16.5
BANANA 35
BANANA 20
BANANA 36
ORANGE 45
ORANGE 15
ORANGE 50

In RAW DATA sheet in Column B I have to input APPLE/BANANA/ORANGE in various rows.

I want that if in B2 I have entered APPLE then in C2 I can enter only 10 or 15 or 16.5 if anything else I will enter then I will get error message that enter correct value. Similarly If I will enter Banana in column B of Raw Data sheet then I can only input values 35 or 20 or 36 in the column C

SO what will be the code for Column C of Raw Data sheet to do so ?

 

[Takae]

Copy to sheet module of RAW DATA sheet.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dic, i As Long, LR As Long
Dim list As String
Dim Dws As Worksheet
    If Intersect(Target, Range("B:B")) Is Nothing Then
        Exit Sub
    Else
        Set Dws = Sheets("DATA")
        Set Dic = CreateObject("scripting.Dictionary")
    
        On Error Resume Next
        With Dws
            LR = .cells(Rows.Count, 1).End(xlUp).row
            For i = 1 To LR
                If .cells(i, 1).Value = Target.Value Then
                    Dic.Add .cells(i, 2).Value, .cells(i, 2).Value
                End If
            Next
        End With
    
        If Dic.Count = 0 Then
            MsgBox Target.Value & " does not exist in DATA sheet."
            Target.Offset(0, 1).Validation.Delete
            Exit Sub
        End If
        
        list = Join(Dic.keys, ",")
        
        With Target.Offset(0, 1).Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=list
            .IgnoreBlank = True
            .InCellDropdown = True
            .ShowInput = True
            .ShowError = True
        End With
        Set Dic = Nothing
    End If
End Sub