VBA Vlookup Mismatch Error

[Olson14]

I posted my full VBA, however, my question really only pertains to the Vlookup portion roughly 10 lines down. Each time I try to run this, I receive a Mismatch Error for the Vlookup line. Hoping someone could help me figure out what might be wrong? I appreciate your help in advance.

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

    Dim KeyCells As Range, rng As Range, Cell As Range
    Set rng = Sheets("Lists").Range("MngrList")
    Set KeyCells = Sheets("Division").Range("A2")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
    Is Nothing Then
            
        Sheets("Division").Range("B6:F300").ClearContents
        
        For Each Cell In rng
            If Application.VLookup(Cell, Sheets("EmpData").Range("A:E"), 5, True) = Sheets("Division").Range("A2").value Then
                Sheets("Division").Range("B300").End(xlUp).Offset(1, 0) = Cell.value
            End If
        Next
        
            Range("B6").Select
            Range(Selection, Selection.End(xlDown)).Select
            Application.CutCopyMode = False
            ActiveSheet.Range("$B$5:$B$500").RemoveDuplicates Columns:=1, Header:=xlYes
            ActiveWorkbook.Worksheets("Division").Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Division").Sort.SortFields.Add2 Key:=Range("B6"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Division").Sort
            .SetRange Range("B6:B500")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    
        If KeyCells = "IDC" Then
            Rows("6:6").Delete Shift:=xlUp
        End If
        
    Dim Drng As Range
    Set Drng = Sheets("Division").Range("DivRange")
        
        For Each Cell In Drng
            Cell.Offset(0, 1).Formula = "=IF((COUNTIFS(Entries!$A:$A,$B" & Cell.Row & ",Entries!$E:$E,$C$4,Entries!$F:$F,Division!$A$2)/COUNTIFS(EmpData!$B:$B,Division!$B" & Cell.Row & ",EmpData!$E:$E,Division!$A$2))>1,1,(COUNTIFS(Entries!$A:$A,$B" & Cell.Row & ",Entries!$E:$E,$C$4,Entries!$F:$F,Division!$A$2)/COUNTIFS(EmpData!$B:$B,Division!$B" & Cell.Row & ",EmpData!$E:$E,Division!$A$2)))"
            Cell.Offset(0, 1) = Cell.Offset(0, 1).value
            Cell.Offset(0, 2).Formula = "=IF((COUNTIFS(Entries!$A:$A,$B" & Cell.Row & ",Entries!$E:$E,$D$4,Entries!$F:$F,Division!$A$2)/COUNTIFS(EmpData!$B:$B,Division!$B" & Cell.Row & ",EmpData!$E:$E,Division!$A$2))>1,1,(COUNTIFS(Entries!$A:$A,$B" & Cell.Row & ",Entries!$E:$E,$D$4,Entries!$F:$F,Division!$A$2)/COUNTIFS(EmpData!$B:$B,Division!$B" & Cell.Row & ",EmpData!$E:$E,Division!$A$2)))"
            Cell.Offset(0, 2) = Cell.Offset(0, 2).value
            Cell.Offset(0, 3).Formula = "=IF((COUNTIFS(Entries!$A:$A,$B" & Cell.Row & ",Entries!$E:$E,$E$4,Entries!$F:$F,Division!$A$2)/COUNTIFS(EmpData!$B:$B,Division!$B" & Cell.Row & ",EmpData!$E:$E,Division!$A$2))>1,1,(COUNTIFS(Entries!$A:$A,$B" & Cell.Row & ",Entries!$E:$E,$E$4,Entries!$F:$F,Division!$A$2)/COUNTIFS(EmpData!$B:$B,Division!$B" & Cell.Row & ",EmpData!$E:$E,Division!$A$2)))"
            Cell.Offset(0, 3) = Cell.Offset(0, 3).value
            Cell.Offset(0, 4).Formula = "=IF((COUNTIFS(Entries!$A:$A,$B" & Cell.Row & ",Entries!$E:$E,$F$4,Entries!$F:$F,Division!$A$2)/COUNTIFS(EmpData!$B:$B,Division!$B" & Cell.Row & ",EmpData!$E:$E,Division!$A$2))>1,1,(COUNTIFS(Entries!$A:$A,$B" & Cell.Row & ",Entries!$E:$E,$F$4,Entries!$F:$F,Division!$A$2)/COUNTIFS(EmpData!$B:$B,Division!$B" & Cell.Row & ",EmpData!$E:$E,Division!$A$2)))"
            Cell.Offset(0, 4) = Cell.Offset(0, 4).value
        Next
        
End If


End Sub

 

[Anthony47]

Try this version

        For Each Cell In Rng
            If Not IsError(Application.VLookup(Cell.Value, Sheets("EmpData").Range("A:E"), 5, True)) Then
                If Application.VLookup(Cell.Value, Sheets("EmpData").Range("A:E"), 5, True) = Sheets("Division").Range("A2").Value Then
                    Sheets("Division").Range("B300").End(xlUp).Offset(1, 0) = Cell.Value
                End If
            End If
        Next

You will notice the extra If /EndIf structure

Bye

 

[Olson14]

Try this version

        For Each Cell In Rng
            If Not IsError(Application.VLookup(Cell.Value, Sheets("EmpData").Range("A:E"), 5, True)) Then
                If Application.VLookup(Cell.Value, Sheets("EmpData").Range("A:E"), 5, True) = Sheets("Division").Range("A2").Value Then
                    Sheets("Division").Range("B300").End(xlUp).Offset(1, 0) = Cell.Value
                End If
            End If
        Next

You will notice the extra If /EndIf structure

Bye

Anthony, This worked perfectly. Thank you for the help. Regards