Create random passwords for each of my customers in Excel

:confused: I have been beating my head against a wall since yeterday afternoon. I need to create random, if possible, passwords for each of my customers in an Excel database. We are in the processes of moving all of our customer information to a website and we need to generate passwords for each of them.

The web designer is not using any type of encryption (I don't completely understand why), it does not need to be in web format, and I am running Office Professional 2003. I would have attached an example of the spread sheet but, I don't know how. Here is the other problem with this project, I have no clue as to what I am doing and I am the one in our office that is the most knowledgeable with Excel. Sad, Isn't it? We would like the password to look like this a34567, but will take 345678.



I have never used VB before and don't know how to apply it to a spread sheet. Any and all help is greatly appreciated!

:roll:

The following code will create a letter + 6 figure password in column B for each name in column A, until there is a gap. These are not necessarily unique, but chance is pretty good.
MD

Code:

---

Sub NewPass()
Do
    If ActiveCell.Offset(0, -1) <> "" Then
        ActiveCell.Formula = Chr(Int((26 * Rnd) + 97)) & Format(Int(1000000 * Rnd), "000000")
        ActiveCell.Offset(1, 0).Select
    Else
        Exit Sub
    End If
Loop
End Sub

---

VBA Instructions for Excel

A: To add a macro to a workbook

1. Create a new Workbook
2. Open VBA by pressing Alt-F11
3. In the left hand pane you should see the Project Explorer window
4. If you don't see it, select the View Menu and choose it (or press Ctrl+R)
5. Right click on your workbook name and choose Insert->Module
6. Copy, then Paste the suggested code in the right-hand pane
7. Save the file (press the Save toolbar button) Enter any name you'd like for it.
8. Exit VBA

Note: If you are adding code to an existing workbook, skip step one.

B: To run a macro

1. In the Excel window, select Tools->Macro->Macros...
2. Select the macro name from the dropdown list, then hit the Run button

Thank you, so much! ! ! ! Can I ask one more question? How do I apply it to the spread sheet?

OOPS, sorry I didn't see your instructions. THANK THANK THANK! !

Sample Attached

:type

Okay, You are great and I am really sorry to have to bother you again, but I need a total of six character so a letter and five numbers. What part of the code designates how many numbers and I can just change it. Also, which part of the code designates the columns? I need passwords in column I for names in column A. Is it the part of the code that looks like this (0, -1) and then (1, 0)?

Hi, Its as easy to give you the whole thing.
FYI,
The Offset refers to (Row, Column)
The 100000 mutiplies a random figure between 0 and 1 to give the 5/6 figure value and the Format adds leading 0 where required.
MD

Code:

---

Sub NewPass()
Do
    If ActiveCell.Offset(0, -8) <> "" Then
        ActiveCell.Formula = Chr(Int((26 * Rnd) + 97)) & Format(Int(100000 * Rnd), "00000")
        ActiveCell.Offset(1, 0).Select
    Else
        Exit Sub
    End If
Loop
End Sub

---

You should call Randomize at the start of the sub.

Thanks,
Does it make a difference for a one-off use as described?
MD

:dance:

It worked, It worked!!!! If I knew you I would kiss you! :kiss

Thank you so much. Now I just need to remember how to check for duplicates and make sure there are all unique and I can call it a day. I really can't thank you enough.

While pulling my hair out tryint to figure this out today, I have decided this is something I want to learn, so you will be stuck with more questions I am sure.

Thank you again, I can not tell you how much I appreciate your help.


:bigdance2

Here's some code to check for duplicates. It assumes your passwords are in Column I, starting at cell I1, and uses cols L-N to report.
MD

:vv

Code:

---

Sub CheckDups()
    Rw = Range("I1").End(xlDown).Row()
    Range("I1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("M1").Select
    ActiveSheet.Paste
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("L1").Select
    Range(Cells(1, 12), Cells(Rw, 12)).Select
    Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
        Step:=1, Trend:=False
    Columns("L:M").Select
    Range("M1").Activate
    Selection.Sort Key1:=Range("M1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],""Duplicate"",""OK"")"
    Range("N2").Select
    Selection.AutoFill Destination:=Range(Cells(2, 14), Cells(Rw, 14))
Columns("N:N").Select
    With Selection
    Set c = .Find(What:="Duplicate", After:=ActiveCell, LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            i = i + 1
            c.Offset(-1, -2).Range("A1:B2").Select
            With Selection.Interior
                .ColorIndex = 6
                .Pattern = xlSolid
            End With
            Set c = .FindNext©
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
    End With
    Range("N1").Select
    If i = 0 Then
    MsgBox "No duplicates found"
    Else
    MsgBox i & " set(s) of duplicates found"
    End If
End Sub

---

You are wonderful. Isn't there another way to check for duplicates? I am just curious because I thought I did before, and that certainly wasn't the way I did it.

I hope you didn't have to type all of that. Can you have them saved somewhere and just alter them slighty?

Thank you again. You have no idea how relieved I am now.

Thankfully the Macro Recorder does all the hard work, and cut and paste from there.
Glad it worked out
MD

Hey,

You should be able to shorten up that top (macro) section a bit...

Code:

---

Dim Rw As Integer
    Rw = Range("I1").End(xlDown).Row
    Range("I1").End(xlDown).Copy Range("M1")
    Range("L1").Value = "1"
    Range("L1", Range("L" & Rw)).DataSeries
    Columns("L:M").Sort Key1:=Range("M1"), Order1:=xlAscending, Header:=xlGuess
    Range("N2").FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],""Duplicate"",""OK"")"
    Range("N2").AutoFill Destination:=Range(Cells(2, 14), Cells(Rw, 14))

---