Hello everyone. I am a VBA beginner so require some assistance. I am trying to extract unique values from a range in the Active Worksheet for different scenarios (conditions/filtering criteria). I have managed to make it work for the "None/No Filter" condition but now I am stuck. I am trying to check each value from my range with another Sheet(Column A) using VLookUp and then Extract ONLY the values which satisfy the Criteria "=9" from Column F.
Both xGrade and MyData are Variants so I am not sure why it results in a mismatch error. Here is the code. Thank you.
Sub UpdateList()
Dim MyDict As Object, MyCols As Variant, OutCol As String, LastRow As Long, Filter1 As String, Filter2 As String
Dim InputSh As Worksheet, OutputSh As Worksheet
Dim x As Variant, i As Long, j As Long, MyData As Variant, xGrade As Variant, FltrRange As Range
Set MyDict = CreateObject("Scripting.Dictionary")
Set InputSh = Sheets("Teachers and Courses")
MyCols = Array("B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L")
Set OutputSh = Sheets("Teachers and Courses")
OutCol = "A"
Set FltrRange = Sheets("Course List").Range("A3:G91")
Filter1 = Range("D11").Value
Filter2 = Range("D12").Value
Worksheets("Teachers and Courses").Range("A12:A89").Clear
If Filter1 = "None" Then
For Each x In MyCols
LastRow = Range("M" & Rows.Count).End(xlUp).Row
MyData = InputSh.Range(x & "3:" & x & LastRow).Value
For i = 1 To UBound(MyData)
If MyData(i, 1) <> 0 Then MyDict(MyData(i, 1)) = 1
Next i
Next x
OutputSh.Range(OutCol & "12").Resize(MyDict.Count, 1).Value = WorksheetFunction.Transpose(MyDict.keys)
End If
If Filter1 = "Grade" And Filter2 = "Grade 9" Then
For Each x In MyCols
LastRow = Range("M" & Rows.Count).End(xlUp).Row
MyData = InputSh.Range(x & "3:" & x & LastRow).Value
For i = 1 To UBound(MyData)
If MyData(i, 1) <> 0 Then xGrade = Application.VLookup(MyData(i, 1), FltrRange, 6, False)
If xGrade = 9 Then MyDict(MyData(i, 1)) = 1
Next i
Next x
OutputSh.Range(OutCol & "12").Resize(MyDict.Count, 1).Value = WorksheetFunction.Transpose(MyDict.keys)
End If
End Sub
Bookmarks