function returning blank on running

I have cell H1 with certain values as "10,1,7,8" dynamically, another cell A1 calls the function as =FindGrade(H1,"Books")...when the values of e.g B is string like "2,11" then it shud check for both 2 and 11 existing in the cell H1 value also but its not working...the result cell is blank... I m trying to get result of function into cell but the cell is always blank

idea is to check the string in chkcell with each value in A,B,C,D etc and generate the new value called Result and populate the A1 with it.

my code is

Function FindGrade(chkcell As String, Eventtype As String) As String
Dim A As String
Dim B As String
Dim C As String
Dim D1 As String
Dim D2 As String
Dim D3 As String

If chkevent = "Books" Then
A = "7"
B = "2,11"
C = "5"
D1 = "4"
D2 = "8,10,12"
D3 = "6"
End If


    
Dim Result As String

Dim x
Dim y
Dim chkfound
    'Updateby Extendoffice
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For Each x In Split(chkcell, ",")
            For Each y In Split(A, ",")
            If x.exists(y) Then
            Result.Add "A"
            chkfound = 1
            Next y
        Next x
        
        If chkfound = 0 Then
        For Each x In Split(chkcell, ",")
            For Each y In Split(B, ",")
            If x.exists(y) Then
            Result.Add "B"
            chkfound = 1
            Next y
        Next x
        End If
        
        If chkfound = 0 Then
        For Each x In Split(chkcell, ",")
            For Each y In Split(C, ",")
            If x.exists(y) Then
            Result.Add "C"
            chkfound = 1
            Next y
        Next x
        End If
        
        If chkfound = 0 Then
        For Each x In Split(chkcell, ",")
            For Each y In Split(D1, ",")
            If x.exists(y) Then
            Result.Add "D1"
            chkfoundD = 1
            Next y
        Next x
        End If
        
        If chkfound = 0 Then
        For Each x In Split(chkcell, ",")
            For Each y In Split(D2, ",")
            If x.exists(y) Then
            Result.Add "D2"
            chkfoundD = 1
            Next y
        Next x
        End If
        
        If chkfound = 0 Then
        For Each x In Split(chkcell, ",")
            For Each y In Split(D3, ",")
            If x.exists(y) Then
            Result.Add "D3"
            chkfoundD = 1
            Next y
        Next x
        End If
        
        If chkfoundD = 0 Then
        For Each x In Split(chkcell, ",")
            For Each y In Split(D3, ",")
            If x.exists(y) Then
            Result.Add "3"
            chkfoundD = 1
            Next y
        Next x
        End If
        
        If chkfoundD = 0 Then
        For Each x In Split(chkcell, ",")
            For Each y In Split(D2, ",")
            If x.exists(y) Then
            Result.Add "2"
            chkfoundD = 1
            Next y
        Next x
            If chkfoundD = 0 Then
                Result.Add "1"
             End If
        
        End If
    End With

  
FindGrade = Result
End Function

in A1 i want it to be "A2" its shud check 10,1,7,8 first with each values in A,B,C,D1,D2,D3 generate the string...in this case it ill be A2