Project Zebra: WE KNOW THAT YOU CAN HEAR US EARTHMEN ►

◄ Project Zebra: You can't really compare what we do to other departments

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

💬 Comments are off, but you can use the mail form to contact or see the about page for social media links.

BLOG  MORE  ABOUT  MAIL