A password generator

cameron_kyle · Feb 13, 2006

Can someone help me?

In column A I have a code i.e. 9458W and in column B I have a clients name i.e. Adrian Goodwill

In column D I was wondering if there was a way to generate a random 8 figure password from by combining the information from column A and B, this needs to be a random unique password anything will do as long as it has 8 figures combining letters and numbers from A and B in column

thanks kyle

SteveO59L · Feb 13, 2006

I concatenated cols A & B, then used

MID(H12,RANDBETWEEN(1,LEN(H12)),1)&MID(H12,RANDBETWEEN(1,LEN(H12)),1)

to generate the first 2 characters.

You could possibly extend this.

Oorang · Feb 13, 2006

Another way:
For random password generators I usually just use a VBA function. You can use a formula with Rand, but the password will change everytime you go to recalculate cells. (Which is not to my personal taste) Here is some sample code:
(There are shorter ways to do this, but I tried to write this in such a way that you can take it apart and understand the concepts if you so choose)

Rich (BB code):

Sub PasswordGenerator()
Dim Password As String
Dim PasswordLength As Byte
Dim LC As Byte                  'Loop Counter
Dim strRndmChr As String
Dim LAC As Byte                 'Lowest Ascii Character
Dim HAC As Byte                 'Highest Ascii Character
Dim UseSymbolics As Boolean
Dim HasSymbolics As Boolean
Dim RandomNumber As Byte
'Set parameters.
PasswordLength = 8
'Visit www.lookuptables.com for the ascii table.
LAC = Asc("0")
HAC = Asc("z")
UseSymbolics = False

Randomize
For LC = 1 To PasswordLength
    'To produce random integers in a given range, use this formula:
    'Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
    Do
        RandomNumber = Int((HAC - LAC + 1) * Rnd + LAC)
        strRndmChr = Chr(RandomNumber)
        HasSymbolics = CheckSymbolics(RandomNumber)
    Loop Until UseSymbolics = True Or HasSymbolics = False
    Password = Password & strRndmChr
Next LC
ActiveCell = Password
End Sub
Private Function CheckSymbolics(RandomNumber As Byte)
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 _
    CheckSymbolics = True Else: CheckSymbolics = False
End Function

Lupin · Feb 13, 2006

Ok, nothing fancy, nothing random but here's a quick formula...

"A I have a code i.e. 9458W and in column B I have a clients name i.e. Adrian Goodwill "

So..
A B D
9458W Adrian Goodwill Adrill94

D1 formula:
=LEFT(B1,3)&RIGHT(B1,3)&LEFT(A1,2)
This takes the first 3 characters of Adrian, the last 3 of Goodwill and the first 2 of 9458W...

Just copy/paste down column D.
Note: If the Last name contains only 2 letters, "Patrich Jo" the formula will return the space...:
Pat Jo94

Simple but not the best.
Lupin

cameron_kyle · Feb 13, 2006

change of mind

There seems to be something wrong with the formula,

I have come to see that it doesn’t mater what figures are placed in column D there is no need for a relation between what is in A and B,
All I need is there a formula that will automatically generate a random array of 8 figures alpha numeric, with mixed case, but this is not essential

NB this however needs to be totally unique, I ant afford to have two passwords the same

Any suggestions

Lupin · Feb 13, 2006

Hi Cameron,

Who's formula ?

Oorang's code, Steve059L's formula or mine (Lupin)...

Does the formula work?
Or is it that you are not happy with the results (which is OK, no pun)

Lupin

NateO · Mar 21, 2006

Re: change of mind

Hello,

Any suggestions

Yes. The way I generate Random Alpha Numeric Chars is with rndStr(), as seen below. The trick is to simply stack keyArr, your array holding the possible characters, with the appropriate characters, and you're in like Flynn.

To ensure X amount of Unique returns, you'll want some additional VBA in the form of a routine that populates an array of returns, first checking to make sure our return is not already in the array. For this example, foobar creates 100, unique, random returns, the upper boundary of the first vector of strArr:

Public Function rndStr(ByRef StrLength As Long) As String
Dim b() As Byte, keyArr() As Byte
Dim i As Long
Let keyArr = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
ReDim b(1 To StrLength * 2)
For i = 1 To StrLength * 2 Step 2
 Let b(i) = keyArr(Int(((UBound(keyArr) + 1) \ 2) * Rnd + 1) * 2 - 2)
Next
Let rndStr = b
End Function

Sub foobar()
Dim strArr(1 To 100, 1 To 1) As String
Dim tmpStr As String, i As Long
For i = LBound(strArr) To UBound(strArr)
 Let tmpStr = rndStr(8)
 If IsNumeric(Application.Match(tmpStr, strArr, 0)) Then
 Do Until Not IsNumeric(Application.Match(tmpStr, strArr, 0))
 Let tmpStr = rndStr(8)
 Loop
 End If
 Let strArr(i, 1) = tmpStr
Next
Let Range("a1").Resize(UBound(strArr, 1)).Value = strArr
End Sub

To generate more or less returns, change the upper boundary of strArr from 100 to whatever. And the example places the returns in A1:AX, where X is also the upper boundary of strArr. To change the top cell as to where this array gets dumped, change A1 to wherever you please.

Hope this helps.

Oorang · Mar 21, 2006

Unique approach, never thought of doing it that way

NateO · Mar 21, 2006

This works pretty quickly on 100 returns. Took about 1:24 mm:ss on 10,000 unique, random String returns...

rndStr() is really fast, so I'm assuming the bottle-neck is the Match() call, peeking at the larger array for a matching String... Perhaps eliminating duplication...

Still works as advertised, though.

Edited by Nate:

Took about 1:23 mm:ss on 10,000 unique, random String returns with the following:

Public Function rndStr(ByRef StrLength As Long) As String
Dim b() As Byte, keyArr() As Byte
Dim i As Long
Let keyArr = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
ReDim b(1 To StrLength * 2)
For i = 1 To StrLength * 2 Step 2
 Let b(i) = keyArr(Int(((UBound(keyArr) + 1) \ 2) * Rnd + 1) * 2 - 2)
Next
Let rndStr = b
End Function

Sub foobar()
Dim strArr(1 To 10000, 1 To 1) As String
Dim tmpStr As String, i As Long
Debug.Print Now
For i = LBound(strArr) To UBound(strArr)
 Let tmpStr = rndStr(8)
 If IsNumeric(Application.Match(tmpStr, strArr, 0)) Then
 Do: Let tmpStr = rndStr(8)
 Loop While IsNumeric(Application.Match(tmpStr, strArr, 0))
 End If
 Let strArr(i, 1) = tmpStr
Next
Let Range("a1").Resize(UBound(strArr, 1)).Value = strArr
Debug.Print Now
End Sub


Pretty much, the same result...

A password generator

cameron_kyle

Active Member

Excel Facts

SteveO59L

Well-known Member

Oorang

Well-known Member

Lupin

New Member

cameron_kyle

Active Member

Lupin

New Member

NateO

Legend

Oorang

Well-known Member

NateO

Legend

Similar threads

Forum statistics

Share this page

A password generator

Active Member

Excel Facts

Well-known Member

Well-known Member

New Member

Active Member

New Member

Legend

Well-known Member

Legend

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock