Macro to Count Filter Distinct unique Value

I Have Table like this, where i have to use macro because my table always change Every day (SSAS) so i have use macro to filter automatically,

I am able to sum Amount based on same Vendorname, PONuber and Date on Column E (Subtotal).

and then filter to show Subtotal AMount >500

I want to show only row >500 (Column E), and pop up message to count PONumber (Column B) how many Unique PO Number (Only Visible Row to count)

i've been stuck how to count only Visible Unique PO Number and show it on Pop Up message

this is my Macro

Sub FilterCOunt_Click()
Dim Condition As Variant
Dim AVal As Variant
Dim LastRow As Long
Dim Hide, popup  As Long
Dim message  As String

Dim sht As Worksheet
'----------------------------
Dim dictionary As Object
Set dictionary = CreateObject("scripting.dictionary")
'---------------------------
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.AskToUpdateLinks = False
        Application.DisplayAlerts = False
        Application.Calculation = xlAutomatic
        Application.ScreenUpdating = False
        Application.StatusBar = False
'------------------
Columns.EntireColumn.Hidden = False
Rows.EntireRow.Hidden = False
Columns("E:Z").EntireColumn.Delete
Range("E:Z").EntireColumn.Insert
Range("E1").Value = "Sub Total >500 "

Set sht = ActiveSheet

LastRow = sht.Range("B"& Rows.Count).End(xlUp).Row
'-------------------


For i = 2 To LastRow ' with last row count =SUMIFS(I:I,A:A,A8,B:B,B8,C:C,C8)

     AVal = "A"& i

     BVal = "B"& i

     CVal = "C"& i
     Worksheets("Sheet3").Range("E"& i).Formula = "=SUMIFS(D:D,A:A,"& AVal & ",B:B,"& BVal & ",C:C,"& CVal & ")"

Next i

With sht.Range("E1:E"& LastRow)
.AutoFilter
.AutoFilter field:=1, Criteria1:=">=500"

End With
'----------Count Pop UP
Dim CountPO As Long
Range("G1").FormulaArray =  "=SUM(IF(FREQUENCY(IF(SUBTOTAL(3,OFFSET(B2,ROW(B2:B22)-ROW(B2),1)),IF(B2:B22<>"",MATCH(""&B2:B22,B2:B22&"",0))),ROW(B2:B22)-  ROW(B2)+1),1))"


MsgBox "We Found "& CountPO & " PO Open(s)", _
vbInformation, "PO Found"
End Sub

and this is the formula to count it

{=SUM(IF(FREQUENCY(IF(SUBTOTAL(3,OFFSET(B2,ROW(B2:B22)-ROW(B2),1)),IF(B2:B22<>"",MATCH("~"&B2:B22,B2:B22&"",0))),ROW(B2:B22)-ROW(B2)+1),1))}