Modify - Generate mixed random alphanumeric code

[flds]

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

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

 

[Logit]

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

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

 

[shg]

Another way:

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

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

 

[flds]

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

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

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

 

[flds]

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

Another way:

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

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

 

[shg]

It's a user-defined function that makes random strings like those shown.

 

[Logit]

.
My apologies. I gave you the wrong macro. Try this one :

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 :

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

Replace with :

MsgBox pw

 

[flds]

Thank you Logit, It works perfect.

 

[flds]

Thank you shg. for the function.

 

[Logit]

.
You are welcome.