passgen.vb

Private Sub GeneratePasswords(sheetName As String, count As Integer)
    For i = 1 To count
        Sheets(sheetName).Cells(i, 2).Value = GeneratePassword
    Next i
End Sub



Public Function GeneratePassword() As String
    Dim lowercase, decimals, special As String
    Dim needLower, needUpper, needDecimal, needSpecial As Boolean
    
    Dim length As Integer
    Dim chars() As String
    Dim rand As Integer
    
    length = Random(txtMin.Value, txtMax.Value)
    ReDim chars(1 To length) As String
    
    needLower = tglOptional1.Value
    needUpper = tglOptional2.Value
    needDecimal = tglOptional3.Value
    needSpecial = tglOptional4.Value
    
    lowercase = "abcdefghijklmnopqrstuvwxyz"
    uppercase = UCase(lowercase)
    decimals = "0123456789"
    specials = "@+/*-.=()#&"
    
    'Debug.Print needLower, needUpper, needDecimal, needSpecial
    
    For i = 1 To length
        Do While chars(i) = vbNullString
            
            rand = Random(1, 4)
            If chars(i) = vbNullString And (needLower Or (chkLowerCase.Value And rand = 1 And Not (needUpper Or needDecimal Or needSpecial))) Then
                chars(i) = GetRandChar(lowercase)
                needLower = False
            End If
            
            If chars(i) = vbNullString And (needUpper Or (chkNumbers.Value And rand = 2 And Not (needLower Or needDecimal Or needSpecial))) Then
                chars(i) = GetRandChar(uppercase)
                needUpper = False
            End If
            
            If chars(i) = vbNullString And (needDecimal Or (chkUpperCase.Value And rand = 3 And Not (needUpper Or needLower Or needSpecial))) Then
                chars(i) = GetRandChar(decimals)
                needDecimal = False
            End If
            
            If chars(i) = vbNullString And (needSpecial Or (chkSpecials.Value And rand = 4) And Not (needUpper Or needDecimal Or needLower)) Then
                chars(i) = GetRandChar(specials)
                needSpecial = False
            End If
        Loop
        
        'Debug.Print "i: " & i & "rand: " & rand & " char: " & chars(i)
    Next i
    
    'Debug.Print "Min: " & txtMin.Value & " Max: " & txtMax.Value
    'Debug.Print "Length: " & length
    'Debug.Print "Chars: " & Join(chars, "")
    
    ShuffleArray chars
    
    'Debug.Print "Chars: " & Join(chars, "")
    GeneratePassword = Join(chars, "")
End Function

Private Function GetRandChar(ByVal chars As String) As String
    GetRandChar = Mid$(chars, Random(1, Len(chars) - 1), 1)
End Function

Function Random(ByVal Low As Integer, ByVal High As Integer) As Integer
    Randomize Timer
    Random = Int((High - Low + 1) * Rnd) + Low
End Function

Public Sub ShuffleArray(arr As Variant)
    Dim min, max, replace As Integer
    Dim swap As Variant
    
    min = LBound(arr)
    max = UBound(arr)
    'Debug.Print min, max
    For i = max To min + 1 Step -1
        replace = Random(min, max)
        'Debug.Print i, replace
        swap = arr(i)
        arr(i) = arr(replace)
        arr(replace) = swap
    Next i
End Sub