Adjusting array of values for filtering for actual values in sheet

[Kurdur]

Hi,

I've been using the following code to autofilter columns in different sheets based on the values next to the users name in our 'Security' sheet.
The user has perhaps 200 unique 'security' values attached to him or her, which would allow that person to view all rows in the filtered sheets with these codes.

However, the sheets do not always contain an observation of each security code. Perhaps one sheet contains 197 of the security values, while another only contains 50.
Seeing as the filters doesn't work if the criteria is set for a nonexisting value I need to remove these values from the array before setting the criteria.

An easy solution would be to get an array of unique values from each sheet and test that against the filter criteria removing all those that don't exist in the sheet.
That solution would be very exhaustive as the sheets contain 100.000-300.000 rows each (with about 500 unique 'security' values).

Do you have any idea how this could be done more efficiently?


Function TilladBrugerensAgentur()
Dim name As String
name = getUserName

' Finder brugerens tilladte agenturer
Dim Rng As Range
Set Rng = Sheets("Sikkerhed - agenturer").Range("A2:A10000")

Dim i, count As Integer
count = Rng.count - 1

Dim result() As String
ReDim result(0 To count)
Dim c As Variant
i = 0

For Each c In Rng.Cells
If c.Value = name Then
result(i) = Trim(c.Offset(0, 1).Value)
i = i + 1
End If
Next

Dim j As Integer
Dim agentur() As String
ReDim agentur(0 To (i - 1))

For j = 0 To (i - 1)
agentur(j) = result(j)
Next

UnlockWorksheets

' Sætter brugerens tilladte agenturer på filtrer i data
Sheets("Aktive Policer").Range("E9:E1000000").AutoFilter Field:=ColumnNumber("E"), Criteria1:=agentur, Operator:=xlFilterValues
Sheets("Afgangsfoerte Policer").Range("E9:E1000000").AutoFilter Field:=ColumnNumber("E"), Criteria1:=agentur, Operator:=xlFilterValues
Sheets("Skader").Range("L9:L1000000").AutoFilter Field:=ColumnNumber("L"), Criteria1:=agentur, Operator:=xlFilterValues
Sheets("ListboxInputAgenturer").Range("M3:M8000").AutoFilter Field:=2, Criteria1:=agentur, Operator:=xlFilterValues


LockWorksheets
End Function

Thanks for your time!