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
A | B | C | D |
---|---|---|---|
Name | Color | Date | Teacher |
Liam | Red | 2/15/2025 | Ms. Brown |
Jayden | Blue | 3/16/2025 | |
Kennedy | Blue | 3/17/2025 | Ms. Taylor |
Lincoln | Red | 3/18/2025 | Mr. Powell |
Olivia | Yellow | 3/19/2025 | |
Brynn | Green | 3/20/2025 | Mr. Ross |
Luke | Green | 3/21/2025 | Ms. Brown |
Josh | Green | 3/22/2025 | Mr. Williams |
Royce | Blue | 3/23/2025 |
Sheet2
A |
---|
Teacher |
Ms. Brown |
Ms. Taylor |
Mr. Ross |
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.
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