input box

[Trevor3007]

Hello,

The code below generates random passwords, & then goes to a2 & a message box appears stating 'enter site site name:-

Sub autocode()
    Static IsRandomized As Boolean
    Dim i As Integer, PW1 As String
    Dim cell As Range, PW As String
    
    
    
    
    If Not IsRandomized Then Randomize: IsRandomized = True
    
    For Each cell In Range("c2:c2663")
        PW = vbNullString
        For i = 1 To 8
            Do
                DoEvents
                PW1 = Chr(Int((96 - 123 + 1) * Rnd + 123)) ' Lower case alpha
            Loop Until InStr(1, PW, PW1, 1) = 0
            PW = PW & PW1
        Next i
        PW = Replace(PW, Mid(PW, Int(8 * Rnd + 1), 1), Int(8 * Rnd + 1))
        cell.Value = PW
    Next cell
        
 
       Application.Goto Reference:="R2C1"
    
    MsgBox "Enter Site Name"
    
    
End Sub

although it works to a point, there is the issue of 'speed it takes to complete & id rather have a input box to put the 'enter 'site name' rather then the 'message box'

can anyone help & sort for me please?

many thanks in advance & hope you have a great rest of your day to.

 

[dmt32]

Hi,
reducing the number of passwords you are creating should speed things up

See if this update to your code does what you want

Sub autocode()
    Static IsRandomized     As Boolean
    Dim GetEntry            As Variant, arr() As Variant
    Dim cell                As Range, rng As Range
    Dim PW1                 As String, PW As String
    Dim i                   As Integer, j As Integer
   
    Const NumberPasswords As Integer = 2663
   
   
   
    If Not IsRandomized Then Randomize: IsRandomized = True
    Set rng = Range("c2:c" & NumberPasswords)
    ReDim arr(1 To rng.Cells.Count)
   
    Application.ScreenUpdating = False
   
    For j = 1 To UBound(arr)
        PW = vbNullString
        For i = 1 To 8
            Do
                DoEvents
                PW1 = Chr(Int((96 - 123 + 1) * Rnd + 123)) ' Lower case alpha
            Loop Until InStr(1, PW, PW1, 1) = 0
            PW = PW & PW1
        Next i
        PW = Replace(PW, Mid(PW, Int(8 * Rnd + 1), 1), Int(8 * Rnd + 1))
        arr(j) = PW
    Next j
   
    'write arr to range
    Cells(2, 3).Resize(UBound(arr)).Value = Application.Transpose(arr)
       
 
    Application.Goto Reference:="R2C1"
  
   Application.ScreenUpdating = True
   Do
   GetEntry = InputBox("Enter Site Name", "Site Name")
    'cancel pressed
    If StrPtr(GetEntry) = 0 Then Exit Sub
   Loop Until Len(GetEntry) > 0
  
   ActiveCell.Value = GetEntry
   
End Sub

Rather than write each password a cell at a time, I have added an array which then places all passwords to the range in one go which may be a little faster.

Change value shown in BOLD to create number passwords as required


Dave

 

[Trevor3007]

ub autocode() Static IsRandomized As Boolean Dim GetEntry As Variant, arr() As Variant Dim cell As Range, rng As Range Dim PW1 As String, PW As String Dim i As Integer, j As Integer Const NumberPasswords As Integer = 2663 If Not IsRandomized Then Randomize: IsRandomized = True Set rng = Range("c2:c" & NumberPasswords) ReDim arr(1 To rng.Cells.Count) Application.ScreenUpdating = False For j = 1 To UBound(arr) PW = vbNullString For i = 1 To 8 Do DoEvents PW1 = Chr(Int((96 - 123 + 1) * Rnd + 123)) ' Lower case alpha Loop Until InStr(1, PW, PW1, 1) = 0 PW = PW & PW1 Next i PW = Replace(PW, Mid(PW, Int(8 * Rnd + 1), 1), Int(8 * Rnd + 1)) arr(j) = PW Next j 'write arr to range Cells(2, 3).Resize(UBound(arr)).Value = Application.Transpose(arr) Application.Goto Reference:="R2C1" Application.ScreenUpdating = True Do GetEntry = InputBox("Enter Site Name", "Site Name") 'cancel pressed If StrPtr(GetEntry) = 0 Then Exit Sub Loop Until Len(GetEntry) > 0 ActiveCell.Value = GetEntry End Sub

wahoo... thanks. Works a treat
have a great rest of your day.

 

[dmt32]

wahoo... thanks. Works a treat
have a great rest of your day.

most welcome - glad update does what you want

Appreciate feedback

Dave

 

[Trevor3007]

NP