Create a password list in Excel

This Excel VBA script will create a random number of passwords with a length of your choosing and however many you want in into a excel list. It uses all letters and numbers and password friendly symbols. Created because I couldn't really find one that did all this and I got tired of going to a website or coming up with my own.

Source Code

This script has not been checked by Spiceworks. Please understand the risks before using it.

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

SubPasswordInput()DimlNumAsIntegerDimpNumAsIntegerlNum=Application.InputBox("Enter desired lenght of password","PASSWORD LENGTH",,,,,,1)'Exit sub if Cancel button usedIflNum=0ThenExitSubDnum=Application.InputBox("Enter number of password to create","PASSWORD NUMBER",,,,,,1)'Exit sub if Cancel button usedIfDnum=0ThenExitSubForx=1ToDnumActiveCell.Offset(0,1).Value=Getpassword(lNum)'pass length of password to fuctionActiveCell.Offset(1,0).Select' moves down cells from active cell till desired password number is reachedNextxEndSubPublicFunctionGetpassword(argLengthAsInteger)AsString' Used a function so that different input methods can call it and it makes it a little smootherDimarrChars(77)AsString' array that holds all the chars for the passwordsDimaPtrAsIntegerDimiRandomNumberAsIntegerForaPtr=0To25IfaPtr<=25ThenarrChars(aPtr)=Chr(aPtr+65)' store upper case charactersarrChars(aPtr+26)=Chr(aPtr+97)' store lower case charactersEndIfIfaPtr<10ThenarrChars(aPtr+52)=Chr(aPtr+48)' store numeric characters twicearrChars(aPtr+62)=Chr(aPtr+48)' to give them equal prevalenceEndIfNextaPtrForx=71To76' loop to store symbolesarrChars(x)=Chr(x-38)Ifx=72Then' removes the ' from the password arrayarrChars(x)=Chr(42)EndIfNextxRandomizeGetpassword=Getpassword&arrChars(Int((51-0+1)*Rnd+0))' makes sure that a letter is always the first charForaPtr=2ToargLengthGetpassword=Getpassword&arrChars(Int(Rnd()*76))NextaPtrEndFunction