Sub listPrjCell()
Dim i As Long
Set prjDict = CreateObject("Scripting.Dictionary")
For i = 5 To Sheets("DataEntry").Cells(Rows.Count, 1).End(xlUp).Row
prjDict.Add Item:=Sheets("DataEntry").Cells(i, 1), Key:=Sheets("DataEntry").Cells(i, 1).Value
Next
End Sub