Project Zebra: WE KNOW THAT YOU CAN HEAR US EARTHMEN ►
◄ Project Zebra: You can't really compare what we do to other departments
2018-01-22 📌 Generate strong passwords quickly with Excel
This isn't particularly original, and was inspired by seeing a few solutions. Looking back, probably:
https://stackoverflow.com/questions/17905015/excel-vba-convert-string-to-phonetic-alphabet
https://www.extendoffice.com/documents/excel/642-excel-generate-random-string.html
Add the VBA below in a new module, then the following formulas:
A1 =Scramble(CHAR(RANDBETWEEN(65,90)) &CHAR(RANDBETWEEN(65,90)) &CHAR(RANDBETWEEN(65,90)) &CHAR(RANDBETWEEN(36,38)) &RANDBETWEEN(10,99) &LOWER(CHAR(RANDBETWEEN(65,90)) &CHAR(RANDBETWEEN(65,90)) &RANDBETWEEN(10,99)))
B1 =Wordify(A1)
Which'll give you a fairly strong ten character password for initial allocation plus description of it suitable for giving to the user to help them type it. It's handy for bulk generation too.
Public Function Wordify(my_string As String)
Prefix = ""
output_string = ""
Special = Split("Dollar,Percentage,Ampersand", ",")
NumberWords = Split("Zero,One,Two,Three,Four,Five,Six,Seven,Eight,Nine", ",")
Phonetics = Split("Alfa,Bravo,Charlie,Delta,Echo,Foxtrot,Golf,Hotel,India,Juliett,Kilo,Lima,Mike,November,Oscar,Papa,Quebec,Romeo,Sierra,Tango,Uniform,Victor,Whiskey,Xray,Yankee,Zulu", ",")
For i = 1 To Len(my_string)
my_char = Mid$(my_string, i, 1)
ascii_value = Asc(my_char)
If ascii_value >= 36 And ascii_value <= 38 Then
output_string = output_string & Prefix & Special(ascii_value - 36)
End If
If ascii_value >= 48 And ascii_value <= 57 Then
output_string = output_string & Prefix & NumberWords(ascii_value - 48)
End If
If ascii_value >= 65 And ascii_value <= 90 Then
output_string = output_string & Prefix & "Uppercase " & Phonetics(ascii_value - 65)
End If
If ascii_value >= 97 And ascii_value <= 122 Then
output_string = output_string & Prefix & "Lowercase " & Phonetics(ascii_value - 97)
End If
Prefix = ", "
Next
Wordify = output_string
End Function
Public Function Scramble(Target As Variant)
On Error Resume Next
Dim CL As New Collection
Application.Volatile
Scramble = ""
Do Until CL.Count = Len(Target)
R = Int(1 + Rnd * Len(Target))
CL.Add R, CStr(R)
Loop
For i = 1 To CL.Count
Scramble = Scramble & Mid(Target, CL(i), 1)
Next
End Function
