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.
VBA Code:
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