Password Generator w/specific requirements

MyriadRocker

New Member
Joined
Mar 22, 2010
Messages
12
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!
 

Some videos you may like

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

MyriadRocker

New Member
Joined
Mar 22, 2010
Messages
12

Weaver

Well-known Member
Joined
Sep 10, 2008
Messages
5,196
Are there any other requirements, for instance characters you wouldn't want in the password?
 

kpark91

Well-known Member
Joined
Jul 15, 2010
Messages
1,582

ADVERTISEMENT

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

kpark91

Well-known Member
Joined
Jul 15, 2010
Messages
1,582
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

Board Regular
Joined
Jul 2, 2009
Messages
191

ADVERTISEMENT

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

Well-known Member
Joined
Jul 15, 2010
Messages
1,582
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
Code:
[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

Well-known Member
Joined
Sep 10, 2008
Messages
5,196
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

New Member
Joined
Mar 22, 2010
Messages
12
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:
Code:
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.


Code:
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
 
Last edited:

Subscribe on YouTube

Watch MrExcel Video

Forum statistics

Threads
1,106,926
Messages
5,514,205
Members
408,990
Latest member
fresse68

This Week's Hot Topics

  • Sort code advice please
    Hi, I have the code below which im trying to edit but getting a little stuck. This was the original code which worked fine,columns A-F would sort...
  • SUMPRODUCT with nested If statement
    Hi everyone, Hope you're all well. I'm hoping someone will be able to point me in the right direction with a problem I'm having with a SUMPRODUCT...
  • VBA - simple sort is killing me!
    Hello all! This should be so easy, but not for me, apparently! I have a table of data that can be of varying lengths and widths. My current macro...
  • Compare Two Lists
    I have two Lists and I need to be able to Identify differences between them. List 100 comes from a workbook - the other is downloaded form the...
  • Formula that deducts points for each code I input.
    I am trying to create a formula that will have each student in my class start at 100 points and then for each code that I enter (PP for Poor...
  • Conditional formatting formula required for day of week and a value
    Hi, I have a really simple spreadsheet where column A is the date, column B is the activity total shown as a number and column C states the day of...
Top