Random Passwords and usernames

rbsmit02 · Nov 30, 2004

I have 500 agents trained on a new tool.
I need to create usernames and passwords for them as I am the admin of this tool.

What I need is thus:
column 1 contains first name space last name.
I want column 2 to format the name to a string in the format first initial last name (ray smith = rsmith).

In the third column I need to generate a random password between 6 and 8 charicters with at least 2 letters in the password.

Any pointers on how to do this?
this project needs to take very little of my time so I do not care what type of solution it is.... VBA or formula

Oaktree · Nov 30, 2004

could cheat your way around randbetween...

instead of randbetween(6,8), could use =round(6+rand()*2,0)

and instead of randbetween (1,36), could use =round(1+rand()*35,0)

Not truly random, but probably good enough for your use.

Zack Barresse · Nov 30, 2004

Okay,

Here is some very generic password ...

Sub CreatePassword()
 Dim strPassword$, strFName$, cel As Range, rng As Range, _
 a$, b$, c$, d$, e$, f$, myLen#, i#, myNum#
 Randomize
 Set rng = Range("C2", Range("A65536").End(xlUp).Offset(, 2))
 rng.Clear
 myLen = Int(Rnd() * 2 + 6)
 If myLen > 8 Then myLen = 8
 For Each cel In rng
tryHere:
 myNum = Int(Rnd() * 1000000)
 If myNum > 100000 Then myNum = myNum + 100000
 strFName = cel.Offset(, -2).Value
 a = Chr$(Int(Rnd() * 10) + 97) '97 = 'a'
 b = Chr$(Int(Rnd() * 10) + 107) '107 = 'k'
 c = Chr$(Int(Rnd() * 5) + 117) '117 = 'u'
 If Asc(c) > 122 Then c = Chr(122) 'keeping letters
 d = Chr(Int(Rnd() * 10) + 65) '65 = 'A'
 e = Chr(Int(Rnd() * 10) + 75) '75 = 'K'
 f = Chr(Int(Rnd() * 10) + 85) '85 = 'U'
 If Asc(f) > 90 Then f = Chr(90) 'keeping letters
 Select Case myLen
 Case 8
 strPassword = a & b & myNum
 Case 7
 strPassword = c & myNum
 Case Else
 strPassword = d & e & Left(myNum, 3) & f
 End Select
 On Error Resume Next
 If WorksheetFunction.CountIf(rng, strPassword) > 1 Then
 GoTo tryHere
 End If
 cel.Value = strPassword
 Next cel
End Sub


This is a random 6-8 character password with number and letters. It can have 11, 2 or 3 letters depending on your choice (in the Select Case Statement). Add or remove as desired.

I'm sure there's better out there.. HTH

FinancialAnalystKid · Nov 30, 2004

Here's my attempt.

This generates a 4 digit number then concatenates the last letter of the first name and last letter of last name to give you a 6 digit Password, and checks if its unique before entering the value.

This is assuming:

Column:
A = Last Names
B = First Names
C = User Name
D = Password

Sub RandomPassword()

X = Right(ActiveCell.Offset(0, -3), 1)
Y = Right(ActiveCell.Offset(0, -2), 1)
NewPass:
Z = Int(Rnd * (9999 + 1 - 1000)) + 1000
If WorksheetFunction.CountIf(Range("D1:D65536"), Z & X & Y) > 0 Then GoTo NewPass
ActiveCell = Z & X & Y

End Sub

Someone please verify if the code:
If WorksheetFunction.CountIf(Range("D1:D65536"), Z & X & Y) > 0 Then
is correct.

Thanks

FinancialAnalystKid · Nov 30, 2004

I checked the code:
If WorksheetFunction.CountIf(Range("D1:D65536"), Z & X & Y) > 0 Then

with a lower scale of random numbers 1-9 and it worked. I had to break the macro when there were nomore unique passwords.

But with a scale of 1000-9999 and two alpha characters, I don't think you'll run out of passwords for your company.

tusharm · Nov 30, 2004

I don't know if you are still looking for a solution. If you are, check (you will have to adapt it to work with multiple rows):
Generate a random alphanumeric password
http://www.tushar-mehta.com/excel/tips/rand_alphanum.html

FinancialAnalystKid · Nov 30, 2004

Here's a Macro for User Names as you enter a new person you can run this in the cell next to it (column C) to get a user name.

There's probably an easier way to do this but I just started on VBA so forgive me...

Again I'm assuing the USER NAME is in Column C and Last name in A and first name in B

Sub UserName()

X = LCase(ActiveCell.Offset(0, -2))
Y = LCase(Left(ActiveCell.Offset(0, -1), 1))
N = Y & X
i = 0

If WorksheetFunction.CountIf(Range("c1:c65536"), N) > 0 Then _
GoTo NewName
ActiveCell = N
End

NewName:
N = Y & X
i = i + 1
N = N & i
If WorksheetFunction.CountIf(Range("c1:c65536"), N) > 0 Then _
GoTo NewName
ActiveCell = N

End Sub

rbsmit02 · Dec 1, 2004

Thanks!
To everyone that responded. I learned alot of good tricks from you guys and I am very greatful for all the help!!!!

NateO · Oct 27, 2005

Really late to the party, but if you were to try this in VBA, you might want to have a look at the following:

Code:

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((62 - 1 + 1) * Rnd + 1)) * 2 - 2)
Next
Let rndStr = b
End Function

It's got some chops. You simply feed in the number of return characters, e.g.,

=rndStr(8)

As it's [pseudo-]random, you're not guaranteed to have two Alpha chars, while the probability that you do is decent as there are far more Alpha return possibilities. You could set a flag in the function and recurse on the function if it didn't return what you wanted.

davethemonkey · Oct 31, 2005

NateO,

Just came across this - Awesome! This has really helped me out, and got me respect from my boss - thanks!

NateO · Oct 31, 2005

Very good; glad I did add it, then. You're welcome.

Just make sure you don't adjust the keyArr input without changing the upper boundary, 62.

Or, perhaps I should have made it dynamic, e.g.,

Code:

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

Now, you can change keyArr and the boundaries of the random input-key will dynamically flow.

Random Passwords and usernames

rbsmit02

Board Regular

Oaktree

MrExcel MVP

Excel Facts

Zack Barresse

MrExcel MVP

FinancialAnalystKid

Well-known Member

FinancialAnalystKid

Well-known Member

tusharm

MrExcel MVP

FinancialAnalystKid

Well-known Member

rbsmit02

Board Regular

NateO

Legend

davethemonkey

New Member

NateO

Legend

Similar threads

Forum statistics

Share this page

Random Passwords and usernames

Board Regular

MrExcel MVP

Excel Facts

MrExcel MVP

Well-known Member

Well-known Member

MrExcel MVP

Well-known Member

Board Regular

Legend

New 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