Можем ли да филтрираме стойностите и да ги поставим в масив с помощта на VBScript?

Помислете за таблицата в Excel по-долу:

  Emp Id    Job Status
    741         P
    788         T
    111         T
    124         P
    136         P

Искам усъвършенстван VBScript код, който може да направи такова филтриране с един изстрел, както направихме ръчно в Excel. След филтрирането искам стойностите, филтрирани в първата колона, да се поставят само в масив.

Код

Dim IntRow1,Arr,Index
Index=0

Do while objSheet1.Cells(IntRow1,1) <> ""
    If objSheet1.Cells(IntRow1,2) = "P" Then
        Arr(Index)=objSheet1.Cells(IntRow1,1)
        Index=Index+1
    End If
IntRow1=IntRow1=1
Loop

*АКТУАЛИЗАЦИЯ

Option Explicit

Dim Dic, DicItems, Dickeys
Dim objExcel1
Dim strPathExcel1
Dim objSheet1, lastRow

Set objExcel1 = CreateObject("Excel.Application")

strPathExcel1 = "D:\VA\CopyofGEWingtoWing_latest_dump_21112012.xls"
objExcel1.Workbooks.Open strPathExcel1
Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)

Set Dic = CreateObject("Scripting.Dictionary")

lastRow = 1
Do Until lastRow > objExcel1.Application.WorksheetFunction.CountA(objSheet1.Columns(1))
    Dic.Add objSheet1.Cells(lastRow, 1).Value, objSheet1.Cells(lastRow, 2).Value
    lastRow = lastRow + 1
Loop

DicItems = Dic.Items
Dickeys = Dic.Keys

For lastRow = 0 To Dic.Count - 1
    If DicItems(lastRow) = "P" Then
        Dic.Remove (Dickeys(lastRow))
    End If
Next

DicItems = Dic.Items
'=======================
objExcel1.ActiveWorkbook.SaveAs strPathExcel1
objExcel1.Workbooks.Close
objExcel1.Application.Quit
'======================