Password Generator w/specific requirements

[MyriadRocker]

Hey everyone! I have a need to do a password generator. I have found some great code here but I can't find anything that gets my specific needs met. Here's what I'm looking for...

I need an Excel sheet (Sheet1) that contains a storage for passwords. Let's say the first password in A1 is "Kr$ft##3". That's the first, and only, password there for now.

I want to be able to generate another password in the cell below it whenever I click a button. That would put a password in A2. Then if I click it again, it puts a password in A3. So on and so forth.

However, these are the password requirements:

• a maximum of 2 repeated characters in the password
• a minimum of 3 characters not found in previous password
• a minimum of 3 alphabetic characters
• a minimum of 2 non-alphabetic characters
• a minimum of 8 characters in length but not more than 14 in length
• new password cannot be the same as previous 20 passwords

These requirements are a bit daunting! I'm not sure where to start!

 

[Akashwani]

Hi,

I don't have a solution for you, but see if these will help...


http://simoncpage.co.uk/blog/2008/08/18/excel-vb-random-password-generator/

http://www.freevbcode.com/ShowCode.asp?ID=831

Good luck

Ak

 

[MyriadRocker]

Hi,

I don't have a solution for you, but see if these will help...


http://simoncpage.co.uk/blog/2008/08/18/excel-vb-random-password-generator/

http://www.freevbcode.com/ShowCode.asp?ID=831

Good luck

Ak

Thanks. I already have code working to generate a random password. I have it to where it doesn't repeat a password that has already been used but the other requirements, I'm not sure about. That's where I'm getting kinda hung up.

 

[Weaver]

Are there any other requirements, for instance characters you wouldn't want in the password?

 

[kpark91]

Hmmm this is definitely something I want to work on to kill time :P

 

[kpark91]

Here is some progress:

The printable characters from keyboard's character set # is from 33 ~ 126.
So by using RND() function in VBA, you can generate random numbers between this range
and use Chr() function to print these characters ex. chr(33)

 

[samfolds]

However, these are the password requirements:

• a maximum of 2 repeated characters in the password
• a minimum of 3 characters not found in previous password
• a minimum of 3 alphabetic characters
• a minimum of 2 non-alphabetic characters
• a minimum of 8 characters in length but not more than 14 in length
• new password cannot be the same as previous 20 passwords

These requirements are a bit daunting! I'm not sure where to start!

For 1) Loop through the string and use an if statement : if character at position n=character at position n-1 AND position n-2 then "ERROR"

For 2) Use a counter and loop through all the new password. Use the find function to check if a character is in the previous password. Increment the counter when this is not the case. If counter <3 then "ERROR"

For 3) Again, use a counter and the ASCII Code. http://www.asciitable.com/ Loop through the characters (using the ASC function) and when one is alphabetic, increment counter. If counter <3 then "ERROR"

For 4) Same as previously, but for non-alpha.

For 5) If statement, If len(password) < 8 or len(password)>14 then "ERROR"

For 6) Loop through rows backward (by using step -1) from your new row to "your new row -20" Check if Newpassword=Password in cell above for all 20 cells.

I'm guessing you already have knowledge in VBA since you already have your macro to create password, so simply apply the conditions mentionned above.

Hope this helps.

Samfolds

 

[kpark91]

I've created the whole thing
but the code may not be as efficient as some other ppl would do.
If anybody can point out how it can be done better, it would be most helpful.

Try

[color=darkblue]Dim[/color] count [color=darkblue]As[/color] [color=darkblue]Integer[/color] [color=green]'Incrementing row # for displaying generated passwords[/color]
[color=darkblue]Dim[/color] prevArr(14) [color=darkblue]As[/color] [color=darkblue]String[/color]
[color=darkblue]Dim[/color] lppwd [color=darkblue]As[/color] [color=darkblue]Integer[/color] [color=green]'Length of previous pwd[/color]
[color=darkblue]Private[/color] [color=darkblue]Sub[/color] GeneratePwd_Click()
    [color=darkblue]Dim[/color] lpwd [color=darkblue]As[/color] [color=darkblue]Integer[/color] [color=green]'Pre-established[/color]
    [color=darkblue]Dim[/color] arr(14) [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] randomChar [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] alphaCounter, notAlphaCounter, randomNum [color=darkblue]As[/color] [color=darkblue]Integer[/color]
    
    [color=green]'When A1 Cell is empty, delete entire column and set count as 1[/color]
    [color=darkblue]If[/color] Range("A1").Value = "" [color=darkblue]Then[/color]
        Application.ScreenUpdating = [color=darkblue]False[/color]
        Columns(1).EntireColumn.Clear
        count = 1
        Application.ScreenUpdating = [color=darkblue]True[/color]
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
    [color=green]'When the program is initialized[/color]
    [color=darkblue]If[/color] count = 0 [color=darkblue]Then[/color]
        count = 1
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
    [color=green]'Minimum of 8 characters in length, Maximum of 14 characters in length[/color]
    lpwd = Int((14 - 8 + 1) * Rnd + 8)
    
CheckBlank:
        [color=darkblue]If[/color] Range("A" & count) <> "" [color=darkblue]Then[/color]
            count = count + 1
            [color=darkblue]GoTo[/color] CheckBlank
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    
GeneratePassword:
    alphaCounter = 0
    notAlphaCounter = 0
    
    [color=green]'Generate Password[/color]
    [color=darkblue]For[/color] c = 1 [color=darkblue]To[/color] lpwd
        [color=green]'Generate random characters[/color]
        randomNum = Int((126 - 33 + 1) * Rnd + 33)
        randomChar = Chr(randomNum)
        
        [color=green]'Counting alphabets and non-alphabets[/color]
        [color=darkblue]If[/color] randomNum >= 65 And randomNum <= 90 [color=darkblue]Then[/color]
            alphaCounter = alphaCounter + 1
        [color=darkblue]ElseIf[/color] randomNum >= 97 And randomNum <= 122 [color=darkblue]Then[/color]
            alphaCounter = alphaCounter + 1
        [color=darkblue]Else[/color]
            notAlphaCounter = notAlphaCounter + 1
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        
        Range("A" & count) = Range("A" & count) & randomChar
        arr(c) = randomChar
    [color=darkblue]Next[/color] c
    
    [color=green]'Minimum of 3 alphabets[/color]
    [color=darkblue]If[/color] alphaCounter < 3 [color=darkblue]Then[/color]
        [color=darkblue]GoTo[/color] GeneratePassword
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
    [color=green]'Minimum of 2 non-alphabets[/color]
    [color=darkblue]If[/color] notAlphaCounter < 2 [color=darkblue]Then[/color]
        [color=darkblue]GoTo[/color] GeneratePassword
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
    [color=green]'Maximum of 2 repeated characters[/color]
    [color=darkblue]Dim[/color] Repeat_Switch [color=darkblue]As[/color] [color=darkblue]Integer[/color]
    
    [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] lpwd - 1
        Repeat_Switch = 0
        [color=darkblue]For[/color] j = i + 1 [color=darkblue]To[/color] lpwd
            [color=darkblue]If[/color] Repeat_Switch = 2 [color=darkblue]Then[/color]
                [color=darkblue]GoTo[/color] GeneratePassword
            [color=darkblue]End[/color] [color=darkblue]If[/color]
            
            [color=darkblue]If[/color] arr(i) = arr(j) [color=darkblue]Then[/color]
                Repeat_Switch = Repeat_Switch + 1
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Next[/color] j
    [color=darkblue]Next[/color] i
    
    [color=green]'Minimum of 3 characters not found in previous password[/color]
    [color=darkblue]If[/color] count > 1 [color=darkblue]Then[/color]
        [color=darkblue]Dim[/color] Prev_Switch [color=darkblue]As[/color] [color=darkblue]Integer[/color]
        [color=darkblue]Dim[/color] Equal_Switch [color=darkblue]As[/color] [color=darkblue]Boolean[/color]
        
        Prev_Switch = 0
        
        [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] lpwd
            Equal_Switch = [color=darkblue]False[/color]
            [color=darkblue]For[/color] j = 1 [color=darkblue]To[/color] lppwd
                [color=darkblue]If[/color] arr(i) = prevArr(j) [color=darkblue]Then[/color]
                    Equal_Switch = [color=darkblue]True[/color]
                [color=darkblue]End[/color] [color=darkblue]If[/color]
            [color=darkblue]Next[/color] j
            
            [color=darkblue]If[/color] Equal_Switch = [color=darkblue]False[/color] [color=darkblue]Then[/color]
                Prev_Switch = Prev_Switch + 1
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Next[/color] i
        
        [color=darkblue]If[/color] Prev_Switch < 3 [color=darkblue]Then[/color]
            [color=darkblue]GoTo[/color] GeneratePassword
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
    [color=green]'Cannot be same as previous 20 pwds[/color]
    [color=darkblue]For[/color] c = count - 1 [color=darkblue]To[/color] count - 20 [color=darkblue]Step[/color] -1
        [color=darkblue]If[/color] Range("A" & count) = Range("A" & c) [color=darkblue]Then[/color]
            [color=darkblue]GoTo[/color] GeneratePassword
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] c
    
    count = count + 1
    
    [color=green]'Copying Arr to prevArr[/color]
    [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] lpwd
        prevArr(i) = arr(i)
        lppwd = lpwd
    [color=darkblue]Next[/color] i
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[Weaver]

I made a start on this at work and the only thing I did different was to use .find to check the previous cells for a possible match, i.e if the search came back as a null range then there weren't any.

 

[MyriadRocker]

I've taken some of the advice, modified some of the other stuff, and this is what I have come up with. Works great.

I WANTED to placed the array size in a variable and let the length of the password dictate its size but apparently that's not possible.
Example:

Dim PasswordArray() as String

ReDim PasswordArray(PasswordLength) as String

It works but when you try to use it, it throws a subscript out of range error.

Sub PasswordGenerator()
    Dim PasswordArray(14) As String
    Dim Password As String
    Dim PasswordLength As Integer
    Dim CharCnt As Integer
    Dim RandomChar As String
    Dim LAC As Integer 'Lowest ASCII Character
    Dim HAC As Integer 'Highest ASCII Character
    Dim UseNonAlphas As Boolean
    Dim HasNonAlphas As Boolean
    Dim RandomNumber As Integer
    Dim NumOfPasswords As Integer
    Dim NumPasswordsToCompare As Integer
    Dim i As Long, x As Long
    Dim RowNum As Integer
    Dim AlphaCnt As Integer
    Dim NonAlphaCnt As Integer
    
    'Counts for alphabetic & non-alphabetic characters
    AlphaCnt = 0
    NonAlphaCnt = 0
    
    'The number of consecutive passwords to generate
    NumOfPasswords = 1
    
    'The number of passwords to compare to make sure the password doesn't already exist
    NumPasswordsToCompare = 20
    
    'Produces a random password length between 8 and 14 characters
    PasswordLength = (Int((14 - 8 + 1) * Rnd + 8))
    
    'Visit www.lookuptables.com for the ASCII table.
    LAC = Asc("0")
    HAC = Asc("z")
    
    'Flag to use special characters or not
    UseNonAlphas = True
    
GeneratePassword:

    'Looking for a blank cell to put the password in
    RowNum = 1
    ActiveSheet.Range("A1").Select
    Do Until IsEmpty(ActiveCell)
        RowNum = RowNum + 1
        ActiveCell.Offset(1, 0).Select
    Loop
    
    For i = 1 To NumOfPasswords
        Erase PasswordArray
        Password = ""
        For CharCnt = 1 To PasswordLength
            Do
                RandomNumber = Int((HAC - LAC + 1) * Rnd + LAC)
                RandomChar = Chr(RandomNumber)
                'Checking for non-alphabetics & alphabetics
                If (RandomNumber >= 33 And RandomNumber <= 47) Or _
                    (RandomNumber >= 58 And RandomNumber <= 64) Or _
                    (RandomNumber >= 91 And RandomNumber <= 96) Or _
                    (RandomNumber >= 123 And RandomNumber <= 126) Then
                    HasNonAlphas = True
                Else
                    HasNonAlphas = False
                End If
                'Counting non-alphabetics & alphabetics
                If HasNonAlphas = True Then
                    NonAlphaCnt = NonAlphaCnt + 1
                Else
                    AlphaCnt = AlphaCnt + 1
                End If
            Loop Until UseNonAlphas = True Or HasNonAlphas = False
            PasswordArray(CharCnt) = RandomChar
            Password = Password & RandomChar
        Next CharCnt
        
        'Minimum of 3 alphabetic characters
        If AlphaCnt < 3 Then
            GoTo GeneratePassword
        End If
        
        'Minimum of 2 non-alphabetic characters
        If NonAlphaCnt < 2 Then
            GoTo GeneratePassword
        End If
        
        'Maximum of 2 repeated characters
        For x = 1 To PasswordLength - 2
            If PasswordArray(x) = PasswordArray(x + 1) Then
                If PasswordArray(x) = PasswordArray(x + 2) Then
                    GoTo GeneratePassword
                End If
            End If
        Next x
        
        'Minimum of 3 characters not found in previous password
        If RowNum > 1 Then 'Making sure a previous password exists
            Dim PrevPasswordArray(14) As String
            Dim PrevSwitch As Integer
            Dim EqualSwitch As Boolean
            
            For x = 1 To Len(ActiveSheet.Range("A" & RowNum - 1))
                PrevPasswordArray(x) = Mid(ActiveSheet.Range("A" & RowNum - 1), x, 1)
            Next x

            PrevSwitch = 0
            
            For cnt1 = 1 To PasswordLength
                EqualSwitch = False
                For cnt2 = 1 To PasswordLength
                    If PasswordArray(cnt1) = PrevPasswordArray(cnt2) Then
                        EqualSwitch = True
                    End If
                Next cnt2
                If EqualSwitch = False Then
                    PrevSwitch = PrevSwitch + 1
                End If
            Next cnt1
            If PrevSwitch < 3 Then
                GoTo GeneratePassword
            End If
        End If
        
        'Cannot be the same as previous NumPasswordsToCompare passwords (also works for less than NumPasswordsToCompare)
        If RowNum > NumPasswordsToCompare Then
            For x = RowNum - 1 To RowNum - NumPasswordsToCompare Step -1
                If ActiveSheet.Range("A" & i).Value = Password Then
                    GoTo GeneratePassword
                End If
            Next x
        Else
            For x = 1 To RowNum - 1
                If ActiveSheet.Range("A" & i).Value = Password Then
                    GoTo GeneratePassword
                End If
            Next x
        End If
        
        'Finally placing the password
        ActiveSheet.Range("A" & RowNum).Value = Password
    Next i
    
End Sub