Password Strength Checker

I searched and found an example for checking password strength in VB (go to the experts-exchange link; I tried linking to it directly, but the solution wouldn't display).

The problem is that it is for VB Script, which forbids variable declaration. In VBA, best practice calls for variable declaration, with "Option Explicit" printed at the top of every code module.

The other problem I found is that it loops through the password no less than seven times. Each time it checks for different things (lower case letters, upper case, special chars, etc). My first thought was: "There has to be a way to do this without looping through the password more than once."

So here's what I came up with. The PasswordStrengthCheck function has a few differences from the previous efforts:

Loops through password once per execution
Raises trappable error in case password contains spaces
Passwords of four or less characters will automatically be rated as weak, regardless of what characters are used to create the password

Version 1: Return strength value as Long

The first version of PasswordStrengthCheck returns the numeric strength value assigned to the password. This is the most basic routine, so you would need to write code to handle the output. For example, a Select Case statement that checks the return value of the function and acts accordingly.

Function PasswordStrengthCheck(pwd As String) As Long

Const SPACE_CHAR As String = " "

Dim strength As Long
Dim passwordLength As Long
Dim i As Long
Dim hasLowerCase As Boolean
Dim hasUpperCase As Boolean
Dim hasNumber As Boolean
Dim hasSpecialChar1 As Boolean
Dim hasSpecialChar2 As Boolean
Dim hasSpecialChar3 As Boolean
Dim hasSpecialChar4 As Boolean

passwordLength = Len(pwd)

' check for spaces
If InStr(pwd, SPACE_CHAR) > 0 Then
Err.Raise vbObjectError + 1000, PasswordStrengthCheck, _
"Password must not contain spaces"
Exit Function
End If

' Check Length
Select Case passwordLength
Case Is >= 8
strength = strength + 1
Case Is <= 4
Exit Function
End Select

' loop ONCE through password
For i = 1 To passwordLength
Select Case Asc(Mid$(pwd, i, 1))
Case 97 To 122 ' lowercase
If Not hasLowerCase Then
strength = strength + 1
hasLowerCase = True
End If
Case 65 To 90 ' uppercase
If Not hasUpperCase Then
strength = strength + 1
hasUpperCase = True
End If
Case 48 To 57 ' numbers
If Not hasNumber Then
strength = strength + 1
hasNumber = True
End If
Case 33 To 47 ' specialchars
If Not hasSpecialChar1 Then
strength = strength + 1
hasSpecialChar1 = True
End If
Case 58 To 64 ' specialchars
If Not hasSpecialChar2 Then
strength = strength + 1
hasSpecialChar2 = True
End If
Case 91 To 96 ' specialchars
If Not hasSpecialChar3 Then
strength = strength + 1
hasSpecialChar3 = True
End If
Case 123 To 255 ' specialchars
If Not hasSpecialChar4 Then
strength = strength + 1
hasSpecialChar4 = True
End If
End Select
Next i

PasswordStrengthCheck = strength

End Function

The return values of PasswordStrengthCheck are:

0-2 = weak
3 = medium
4+ = strong

Version 2: Return strength value as String

A modified version of the above function will return the strength as a string value, based on the same criteria as the original code.

Function PasswordStrengthCheck(pwd As String) As String

Const SPACE_CHAR As String = " "

Dim strength As Long
Dim passwordLength As Long
Dim i As Long
Dim hasLowerCase As Boolean
Dim hasUpperCase As Boolean
Dim hasNumber As Boolean
Dim hasSpecialChar1 As Boolean
Dim hasSpecialChar2 As Boolean
Dim hasSpecialChar3 As Boolean
Dim hasSpecialChar4 As Boolean

passwordLength = Len(pwd)

' check for spaces
If InStr(pwd, SPACE_CHAR) > 0 Then
Err.Raise vbObjectError + 1000, PasswordStrengthCheck, _
"Password must not contain spaces"
Exit Function
End If

' Check Length
Select Case passwordLength
Case Is >= 8
strength = strength + 1
Case Is <= 4
strength = 1
GoTo CalculateStrength
End Select

' loop ONCE through password
For i = 1 To passwordLength
Select Case Asc(Mid$(pwd, i, 1))
Case 97 To 122 ' lowercase
If Not hasLowerCase Then
strength = strength + 1
hasLowerCase = True
End If
Case 65 To 90 ' uppercase
If Not hasUpperCase Then
strength = strength + 1
hasUpperCase = True
End If
Case 48 To 57 ' numbers
If Not hasNumber Then
strength = strength + 1
hasNumber = True
End If
Case 33 To 47 ' specialchars
If Not hasSpecialChar1 Then
strength = strength + 1
hasSpecialChar1 = True
End If
Case 58 To 64 ' specialchars
If Not hasSpecialChar2 Then
strength = strength + 1
hasSpecialChar2 = True
End If
Case 91 To 96 ' specialchars
If Not hasSpecialChar3 Then
strength = strength + 1
hasSpecialChar3 = True
End If
Case 123 To 255 ' specialchars
If Not hasSpecialChar4 Then
strength = strength + 1
hasSpecialChar4 = True
End If
End Select
Next i

CalculateStrength:
Select Case strength
Case 0 To 2
PasswordStrengthCheck = "Weak"
Case 3
PasswordStrengthCheck = "Medium"
Case Is >= 4
PasswordStrengthCheck = "Strong"
End Select

End Function

Test Procedure

Following is a procedure to test out both versions of PasswordStrengthCheck, as well as the error trapping. In the example below, for version 1, it returns the number 6. For version 2, it returns "Strong".

Sub TestPasswordCheck()

On Error GoTo ErrorHandler

MsgBox PasswordStrengthCheck("iuhfIUHF8764*&^#*&L")

ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub

Additional Enhancements

Check Spelling

Checking the spelling of the password would confirm that the password isn't found in the dictionary. In my testing, however, even partially random strings were found in the dictionary, so you'll want to test this out.

Add the following right after the variable declarations:

If Application.CheckSpelling(pwd) Then
Exit Function
End If

Check for lookalike substitutions

We could also make a copy of the password and check the copy as follows:

Replace $ with S and see if the new password passes spell check
Replace 1 with i and see if the new password passes spell check

If either situation is true, we can exit the function. This is because passwords with simple letter substitutions (like "M1crosoft" instead of "Microsoft") are weak.

Return value or string

We could, of course, add an additional parameter that allows us to tell the function whether we want the value or the string. The second parameter would be optional, so we don't disturb any existing function calls. i.e.

Function PasswordStrengthCheck(pwd As String, _
Optional returnType As String = "string") As Variant

The function would then need a Select Case or If statement to determine the value of returnType and return either the value or the string representation.

But wait, there's more!

I've gone ahead and created a sample workbook and userform to demonstrate how the PasswordStrengthChecker could be used. Although, there's nothing specific to Excel about the VBA code, so it could be used in Word, Access, Outlook, and so on.

Screenshot:

PSC Initial

The password field is masked with asterisks (*). As you type, the Change Event fires and the password check function is called. Similar to the password checkers you find online, the form shows colored labels to demonstrate the strength of the password. This workbook could easily be turned into an add-in or integrated into a larger application.