Modify - Generate mixed random alphanumeric code

F

flds

Board Regular
Joined
Jun 19, 2008
Messages
78
Office Version
  1. 2021
Platform
  1. Windows
I came across below mentioned code which I liked, I need help in modifying this code.
Is it possible to do so. If yes, I would like to see the generated output with mixed characters and colan punctuation between 2 characters (i.e. F2:3R:87:0T:58) . Note I tried generating a few, I could not see a 0 (zero) generated.
Your response would be appreciated.

Thanks
FLDS

quote_icon.png
Originally Posted by Scott Huish

Code:

Sub createPW()
Dim pw As String
Dim i As Integer
Randomize
For i = 1 To 5
If Int((2 * Rnd) + 1) = 1 Then
pw = pw & Chr(Int(26 * Rnd + 65))
Else
pw = pw & Int(10 * Rnd)
End If
Next i
MsgBox pw
End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
.
This is one way. It will give you a total of 6 random alphanumerics with a COLON every two characters.

Code: 
Option Explicit


Sub createPW()
Dim pw As String
Dim i As Integer


Randomize
    For i = 1 To 5
        If Int((2 * Rnd) + 1) = 1 Then
            pw = pw & Chr(Int(26 * Rnd + 65))
        Else
            pw = pw & Int(10 * Rnd)
        End If
    Next i
    pw = DashIn(pw)
    
    For i = 1 To Len(pw)
        pw = pw + Mid(pw, i, 2) + ":"
    Next
    pw = Right(pw, 9)
    pw = Left(pw, Len(pw) - 1)
MsgBox pw


End Sub




Function DashIn(myText As String)
    Dim i As Integer
    Dim myCharCode As Integer
    Dim myLength As Integer


    Application.Volatile
    myLength = Len(myText)
    For i = 1 To myLength
        myCharCode = Asc(Mid(myText, i, 1))
        If myCharCode >= 48 And myCharCode <= 57 Then
            Exit For
        End If
    Next i
    If i = 1 Or i > myLength Then
        DashIn = myText
    Else
        DashIn = Left(myText, i - 1) & ":" _
          & Mid(myText, i, myLength - 1)
    End If
End Function
 
Upvote 0
Another way:

[Table="width:, class:grid"][tr][td="bgcolor:#C0C0C0"][/td][td="bgcolor:#C0C0C0"]
A​
[/td][td="bgcolor:#C0C0C0"]
B​
[/td][td="bgcolor:#C0C0C0"]
C​
[/td][/tr][tr][td="bgcolor:#C0C0C0"]
1​
[/td][td]L5:CZ:H4:HJ:9T[/td][td]A1: =MakePW(TRUE)[/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
2​
[/td][td]82:BU:YH:KS:EL[/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
3​
[/td][td]1H:TF:GO:BX:56[/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
4​
[/td][td]54:BT:KK:1O:AW[/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
5​
[/td][td]11:2F:PO:H5:NR[/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
6​
[/td][td]7G:XN:9J:3B:2X[/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
7​
[/td][td]1Q:3H:1O:F6:7K[/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
8​
[/td][td]I0:8H:67:IA:YC[/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
9​
[/td][td]CD:WB:FE:8K:44[/td][td][/td][td][/td][/tr]
[tr][td="bgcolor:#C0C0C0"]
10​
[/td][td]1L:BF:XP:OC:5B[/td][td][/td][td][/td][/tr]
[/table]

Code: 
Function MakePW(Optional bVolatile As Boolean = False) As String
  Const sSym        As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  Dim asWd(1 To 5)  As String
  Dim i             As Long

  If bVolatile Then Application.Volatile
  Randomize

  For i = 1 To UBound(asWd)
    asWd(i) = Mid(sSym, Int(36 * Rnd() + 1), 1) & _
              Mid(sSym, Int(36 * Rnd() + 1), 1)
  Next i
  MakePW = Join(asWd, ":")
End Function
 
Upvote 0
Hi,
Thanks for your response and your time.

When I keep hitting run several times, After a few clicks, I get this output "U:::0:0R", ":9:97:7H", "0.00657407407407407" Right align.

Is it possible to explain the code and function. I would like to understand it.

Thanks
FLDS

Logit said:
.
This is one way. It will give you a total of 6 random alphanumerics with a COLON every two characters.

Code: 
Option Explicit


Sub createPW()
Dim pw As String
Dim i As Integer


Randomize
    For i = 1 To 5
        If Int((2 * Rnd) + 1) = 1 Then
            pw = pw & Chr(Int(26 * Rnd + 65))
        Else
            pw = pw & Int(10 * Rnd)
        End If
    Next i
    pw = DashIn(pw)
    
    For i = 1 To Len(pw)
        pw = pw + Mid(pw, i, 2) + ":"
    Next
    pw = Right(pw, 9)
    pw = Left(pw, Len(pw) - 1)
MsgBox pw


End Sub




Function DashIn(myText As String)
    Dim i As Integer
    Dim myCharCode As Integer
    Dim myLength As Integer


    Application.Volatile
    myLength = Len(myText)
    For i = 1 To myLength
        myCharCode = Asc(Mid(myText, i, 1))
        If myCharCode >= 48 And myCharCode <= 57 Then
            Exit For
        End If
    Next i
    If i = 1 Or i > myLength Then
        DashIn = myText
    Else
        DashIn = Left(myText, i - 1) & ":" _
          & Mid(myText, i, myLength - 1)
    End If
End Function
Click to expand...
 
Upvote 0
Hi shg,

Thanks for your response and time.
I would like to know what was the reason of this function. I tried running it and it does not work. What am I doing wrong?
If you dont mind could you please explain the function.

Thanks
FLDS

shg said:
Another way:

[TABLE="class: grid"]
[TR]
[TD="bgcolor: #C0C0C0"][/TD]
[TD="bgcolor: #C0C0C0"]
A​
[/TD]
[TD="bgcolor: #C0C0C0"]
B​
[/TD]
[TD="bgcolor: #C0C0C0"]
C​
[/TD]
[/TR]
[TR]
[TD="bgcolor: #C0C0C0"]
1​
[/TD]
[TD]L5:CZ:H4:HJ:9T[/TD]
[TD]A1: =MakePW(TRUE)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="bgcolor: #C0C0C0"]
2​
[/TD]
[TD]82:BU:YH:KS:EL[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="bgcolor: #C0C0C0"]
3​
[/TD]
[TD]1H:TF:GO:BX:56[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="bgcolor: #C0C0C0"]
4​
[/TD]
[TD]54:BT:KK:1O:AW[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="bgcolor: #C0C0C0"]
5​
[/TD]
[TD]11:2F:PO:H5:NR[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="bgcolor: #C0C0C0"]
6​
[/TD]
[TD]7G:XN:9J:3B:2X[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="bgcolor: #C0C0C0"]
7​
[/TD]
[TD]1Q:3H:1O:F6:7K[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="bgcolor: #C0C0C0"]
8​
[/TD]
[TD]I0:8H:67:IA:YC[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="bgcolor: #C0C0C0"]
9​
[/TD]
[TD]CD:WB:FE:8K:44[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="bgcolor: #C0C0C0"]
10​
[/TD]
[TD]1L:BF:XP:OC:5B[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[/TABLE]


Code: 
Function MakePW(Optional bVolatile As Boolean = False) As String
  Const sSym        As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  Dim asWd(1 To 5)  As String
  Dim i             As Long

  If bVolatile Then Application.Volatile
  Randomize

  For i = 1 To UBound(asWd)
    asWd(i) = Mid(sSym, Int(36 * Rnd() + 1), 1) & _
              Mid(sSym, Int(36 * Rnd() + 1), 1)
  Next i
  MakePW = Join(asWd, ":")
End Function
Click to expand...
 
Upvote 0
It's a user-defined function that makes random strings like those shown.
 
Upvote 0
.
My apologies. I gave you the wrong macro. Try this one :

Code: 
Option Explicit


Sub createPW()
Dim pw As String
Dim i As Integer
Dim s As String


Randomize
    For i = 1 To 5
        If Int((2 * Rnd) + 1) = 1 Then
            pw = pw & Chr(Int(26 * Rnd + 65))
        Else
            pw = pw & Int(10 * Rnd)             '<-- adjust 10 up / down by 2's
        End If
    Next i 'pw = DashIn(pw)
                                                ' To lengthen or shorten pw edit above and below
    For i = 1 To Len(pw)
        pw = pw + Mid(pw, i, 2) + ":"
    Next
    pw = Right(pw, 9)                           '<-- adjust 9 up / down by odd #'s
    pw = Left(pw, Len(pw) - 1)


Sheets("Sheet1").Range("H5").Value = pw


End Sub

The above will display the password in cell H5. If you still want it to show in a message box, delete this line :

Code: 
Sheets("Sheet1").Range("H5").Value = pw

Replace with :

Code: 
MsgBox pw
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Random String generator throwing out duplicates issue
2
Replies
12
Views
436
6StringJazzer
6StringJazzer
VinceF
  • Solved
Modify Rand# Generator VBA
Replies
4
Views
58
Joe4
Joe4
H
  • Solved
Macro to generate nmbers
2
Replies
11
Views
1K
RustamMika
R
dreid1011
  • Question Question
Recursive Sub Calls and Stack Overflow
2 3
Replies
21
Views
291
6StringJazzer
6StringJazzer
D
  • Solved
VBA Code to generate unique random numbers based on criteria
Replies
2
Views
1K
ddub25
D

Forum statistics

Threads
1,224,820
Messages
6,181,154
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top