Slow For Each Element in Array Loop with Instr - arrays

Question

I need to check if values (approx 10.000 insecure passwords) stored in a one-dimensional array occur in a TextBox and display a warning if necessary.
But due to the constant checking after each keystroke the input into the TextBox is very delayed.
Does anyone know a faster way to do this?
Greetings Ronny
'ForbiddenPasswords = one-dimensional array
Private Sub txtAdminPassword_Change()
Dim VarDat As Variant
For Each VarDat In ForbiddenPasswords
If InStr(1, LCase(txtAdminPassword.Text), VarDat) > 0 Then
lblInsecureWarning.Visible = True
Exit For
End If
Next
End Sub

Answer 1

Rather than loading the list of banned passwords in an array and searching through it to find if it exists, consider using a table to store the (lower case) passwords. You can then open a recordset based on the text entered, and see if it returns any records. Something like:
Function fCheckBannedPWD(strPWD As String) As Boolean
' returns true if the entered password is banned, otherwise false
On Error GoTo E_Handle
Dim db As DAO.Database
Dim rsPWD As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
strSQL = "SELECT BannedPWD FROM tblPWD WHERE InStr('" & LCase(strPWD) & "',BannedPWD)>0;"
Set rsPWD = db.OpenRecordset(strSQL)
If Not (rsPWD.BOF And rsPWD.EOF) Then
fCheckBannedPWD = True
End If
fExit:
On Error Resume Next
rsPWD.Close
Set rsPWD = Nothing
Set db = Nothing
Exit Function
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "fCheckBannedPWD", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume fExit
End Function
Regards,

Answer 2

Arrays want to be iterated with For...Next; Object collections want to be iterated with For Each...Next. Using For Each to iterate a large array is going to be slower than it needs to be.
Converting 10K strings to lowercase is also taking a toll on performance.
Using InStr is verifying whether the password contains the forbidden password, not whether it is one of them: assuming you mean to check if the user's password exists in the forbidden passwords list, you don't need InStr.
If you want to stick with an array, use For...Next to iterate it, and specify Option Compare Text to have the = operator treat "string" the same as "STRING" (default is Option Compare Database in Access, which matches your database settings - in all other hosts it's Option Compare Binary, which is case-sensitive).
But you shouldn't need to iterate any array. Assuming the 10K strings are all unique, you can have them added to a keyed Collection, and then you can instantly know if the user's password is in the collection by trying to add the user's password to the collection:
Private Function IsForbiddenPassword(ByVal Value As String) As Boolean
'assuming a ForbiddenPasswords global collection exists
On Error Resume Next
ForbiddenPasswords.Add Value, Value 'if the key already exists, an error is raised
If Err.Number <> 0 Then
'key already exists: password is forbidden
IsForbiddenPassword = True
Else
'.Add was successful, password is not forbidden (gotta remove it now!)
ForbiddenPasswords.Remove Value
End If
On Error GoTo 0
End Function
Alternatively, use a Scripting.Dictionary and its Exists method, which returns True if a given key already exists:
Private Sub txtAdminPassword_Change()
'where ForbiddenPasswords is a Dictionary instance keyed with the passwords:
lblInsecureWarning.Visible = ForbiddenPasswords.Exists(Value)
End Sub

Answer 3

Try the next way, please:
Create a Private variable on top of the module (in the declarations area):
Private objExcel As Object
Copy the next function code:
Function passExists(strPass As String, arr) As Boolean
Dim lPath As String
lPath = UCase(strPass)
passExists = Not IsError(objExcel.Application.match(lPath, arr, 0))
End Function
It can be checked in the next way:
Sub checkPasswordInArray()
Dim ForbiddenPasswords, boolMatch As Boolean, strPass As String
If objExcel Is Nothing Then Set objExcel = CreateObject("Excel.Application")
ForbiddenPasswords = Split("pass1,pass2,pass3", ",")
strPass = "Pass2" 'txtAdminPassword.Text
Debug.Print passExists(strPass, ForbiddenPasswords)
End Sub
In order to be very fast, objExcel must not be created each time you need to use the function, but you must take care to quit after using it...

Answer 4

Just to be complete, 2 additions to the propositions found.
txtAdminPassword.Text LIKE vardat & "*" is about 6x faster than
InStr(1, LCase(txtAdminPassword.Text), VarDat) > 0
for even better perf with your array, you can use Filter:
Dim strSubNames As Variant
strSubNames = Filter(forbiddenPasswords, txtAdminPassword.Text)