How to display items in listbox using VLookup from another sheet in VBA

I have here Sheet1 that contains dynamic items from Columns A to D. I have Column D with Teachers names but also blanks in it. I also have Sheet2 that contains Teachers names. I would like to display only items from A to D according to the current month but I would like to display items where Teacher cells are blank and NOT EQUAL to Teacher names in Sheet2.

Sheet1

Sheet2

ListBox:

Desired Display:

Current code I have for displaying according to current month that does not have VLookUp (but desired to have VLookUp-just don't know how to insert it in VBA):

Private Sub UserForm_Initialize()
Dim ws As Worksheet, colList As Collection
Dim arrData, arrList, i As Long, j As Long
Dim sampledate As Date
sampledate = Format(Now, "mmmm yyyy")    
Set colList = New Collection
Set ws = Worksheets("Sheet1")
arrData = ws.Range("A1:D" & ws.Cells(ws.Rows.count, "A").End(xlUp).Row)           
For i = 2 To UBound(arrData)            
        If Format(arrData(i, 3), "mmmm yyyy") = sampledate Then
            colList.Add i, CStr(i)
        End If
    'End If
Next    
ReDim arrList(1 To colList.count + 1, 1 To UBound(arrData))
' header
For j = 1 To 4
    arrList(1, j) = arrData(1, j) ' header
    For i = 1 To colList.count
            arrList(i + 1, j) = arrData(colList(i), j)
    Next
Next
ListBox1.Clear    
With Me.ListBox1
    .ColumnCount = UBound(arrData, 2)
    .list = arrList
End With
End Sub

I appreciate your help.

Populate List Box with Filtered Data

A Quick Fix

Private Sub UserForm_Initialize()
    
    Dim sws As Worksheet: Set sws = Sheets("Sheet1")
    Dim srg As Range:
    Set srg = sws.Range("A1:D" & sws.Cells(sws.Rows.Count, "A").End(xlUp).Row)
    Dim arrData() As Variant: arrData = srg.Value
    
    Dim lws As Worksheet: Set lws = Sheets("Sheet2")
    Dim lrg As Range:
    With lws.Range("A1", lws.Cells(lws.Rows.Count, "A").End(xlUp))
        Set lrg = .Resize(.Rows.Count - 1).Offset(1)
    End With
    
    Dim sRowIndices() As Variant:
    sRowIndices = Application.Match(srg.Columns(4), lrg, 0)
    
    Dim MonthYear As Date: MonthYear = Format(Now, "mmmm yyyy")
    Dim collList As Collection: Set collList = New Collection
    
    Dim i As Long, j As Long
    
    For i = 2 To UBound(arrData)
        If Format(arrData(i, 3), "mmmm yyyy") = MonthYear Then
            If arrData(i, 4) = "" Or IsError(sRowIndices(i, 1)) Then
                collList.Add i
            End If
        End If
    Next
    
    ReDim arrList(1 To collList.Count + 1, 1 To UBound(arrData, 2))
    
    For j = 1 To UBound(arrData, 2)
        arrList(1, j) = arrData(1, j)
        For i = 1 To collList.Count
            arrList(i + 1, j) = arrData(collList(i), j)
        Next
    Next
    
    With Me.ListBox1
        .Clear
        .ColumnCount = UBound(arrList, 2)
        .List = arrList
    End With

End Sub