Force user to enter at least one symbol and one number in a textbox through a userform

[christianbiker]

Hi all...I am trying to use various tools within VBA for users to create a password for a profile that they have. I do know that Excel isn't great for this type of security but it's the tool I have and the data isn't super sensitive. I was hoping I could use the INSTR function but can't seem to figure that out. The code I have so far is below and I would appreciate any assistance to force users to enter at least one number and one of the following symbols in the password textbox (ConfirmPassword): ! # $ % &

Private Sub ChangePassword_Click()

  Dim f As Range
  Dim ws As Worksheet
  Dim rng As Range
  Dim answer As Integer
    
    If UserName.Value = "" Or CurrentPassword.Value = "" Or Password.Value = "" Or ConfirmPassword.Value = "" Then GoTo 1

    If Password.Value <> ConfirmPassword.Value Then GoTo 2
    
    If Len(ConfirmPassword.Value) < 8 Then
    MsgBox "Your new password must be a minimum of 8 characters in length."
    Exit Sub
    End If
    
  With UserName
    If .Value = "" Then
      UserName.BackColor = vbYellow
      MsgBox "You must select a client from the drop down box to continue. If the client you are looking for does not exist, a new profile will need to be added."
      Exit Sub
    End If

    '2.Search "Sheet1", Column E2:E200000
    Set f = Sheets("TIER ACCESS").Range("A3:A1502").Find(.Value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then
        If Sheets("TIER ACCESS").Range("A" & f.Row) <> UserName.Value Then GoTo 3
        If Sheets("TIER ACCESS").Range("B" & f.Row) <> CurrentPassword.Value Then GoTo 3
        Sheets("TIER ACCESS").Range("B" & f.Row) = ConfirmPassword.Value
    Else
      MsgBox "No User Profile exists for this individual."
      Exit Sub
    End If
  End With


MsgBox "Client Profile additions/modifications have been made."

Unload Me
Profile_Home.Show

Exit Sub

1:
    If UserName.Value = "" Then UserName.BackColor = vbYellow
    If CurrentPassword.Value = "" Then CurrentPassword.BackColor = vbYellow
    If Password.Value = "" Then Password.BackColor = vbYellow
    If ConfirmPassword.Value = "" Then ConfirmPassword.BackColor = vbYellow

    MsgBox "All fields highlighted in yellow must be populated."
    Exit Sub

2:
    MsgBox "The new password fields do not match."
    Exit Sub

3:
    MsgBox "The Username and/or Current Password fields do not match what is currently on record."
    Exit Sub
    
End Sub

 

[SunnyAlv]

Try to add

..........

If Not ConfirmPassword.Value Like "*[!A-Za-z0-9]*" Then Goto 4

...........

Goto 4

4:
    MsgBox "Please input at least one sysmbol."
    Exit Sub

 

[christianbiker]

Hey Sunny...that works great for requiring a symbol. Thanks for your assistance!

However it does not force users to add at least one number...any idea on how that can be required?

 

[SunnyAlv]

IMO try like this, by changing the entered password value to blank, it will require the user to re-enter the password with a symbol, if it is not entered there will be an error massage then the password value will become blank

4:
    MsgBox "Please input at least one sysmbol."
     ConfirmPassword.Value = ""
    Exit Sub

 

[SunnyAlv]

or you can add an if function with disable commandbutton in your code like this, this code will disable your "ChangePassword" commandbutton,

Me.CommandButton1.Enabled = False

 

[christianbiker]

Those ideas don't seem to force a user to use at least one number. The symbol part works fine but I also need users to have at least one number (0 thru 9) to be included as well.

 

[SunnyAlv]

Ahh i see what u want try this

.....

If Not ConfirmPassword.Value Like "*[!A-Za-z0-9]*" Then Goto 4

If Not ConfirmPassword.Value Like "*[0-9]*" Then Goto 5

.....

.....

4:
    MsgBox "Please input at least one sysmbol."
    Exit Sub

5:
    MsgBox "Please input at least one Number."
    Exit Sub

.....

 

[Artik]

Sub Test()
    MsgBox CheckText("Abcdefgh")    'False
    MsgBox CheckText("Abcef6gh")    'False
    MsgBox CheckText("A!cef6gh")    'True
    MsgBox CheckText("Abcdefg")    'False
    MsgBox CheckText("12345678")    'False
    MsgBox CheckText("12345F78")    'False
    MsgBox CheckText("12$45F78")    'True
End Sub


Function CheckText(Txt As String) As Boolean
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")

    With regex
        .Global = True
        .Pattern = "^(?=.*[0-9])(?=.*[!#$%&])(?=.*[a-zA-Z]).{8,}$"
    End With

    CheckText = regex.Test(Txt)
End Function

Artik

 

[Akuini]

to force users to enter at least one number and one of the following symbols in the password textbox (ConfirmPassword): ! # $ % &

Another option to try:

Function myTest(tx As String) As Boolean
    If tx Like "*[0-9]*[#$%&!]*" Or tx Like "*[#$%&!]*[0-9]*" Then myTest = True
End Function

Sub try()
Debug.Print myTest("$sa#23") 'True
Debug.Print myTest("f1sa!")  'True
Debug.Print myTest("d5sa#")  'True
Debug.Print myTest("dsa22")  'False

End Sub

 

[christianbiker]

Ahh i see what u want try this

.....

If Not ConfirmPassword.Value Like "*[!A-Za-z0-9]*" Then Goto 4

If Not ConfirmPassword.Value Like "*[0-9]*" Then Goto 5

.....

.....

4:
    MsgBox "Please input at least one sysmbol."
    Exit Sub

5:
    MsgBox "Please input at least one Number."
    Exit Sub

.....

Absolutely awesome!!! Thanks Sunny...you rock!