Cell click macro runs

[saxon25]

Hi All just wondering if any one can help i have a macro set to run on cell click that opens a userform that i have working for one cell but i need the same macro to run on 3 specific cells at the moment i have it running on cell D45 but i also need to use the same macro for cells L30, B5

the Userform will request a username and password and then insert the Username in the cell if the correct username and password match this needs to be done for validation purposes so we know who is entering the data.

in the userform the Username will only populate the cell if the username and password is correct.


In Worksheet

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("D45")) Is Nothing Then
    frmInitials.Show
   End If
End Sub

UserForm

Private Sub cmdSubmit_Click()

    Dim wsAdmin As Worksheet
    Dim inputUsername As String
    Dim inputPassword As String
    Dim userLookupResult As Variant
    Dim passLookupResult As Variant
    
    Set wsAdmin = Worksheets("Admin")
    
    inputUsername = txtUsername.Value
    inputPassword = txtPassword.Value
    
    userLookupResult = Application.VLookup(inputUsername, wsAdmin.ListObjects("tblAccessList").DataBodyRange, 1, False)
    passLookupResult = Application.VLookup(inputUsername, wsAdmin.ListObjects("tblAccessList").DataBodyRange, 2, False)
    
    If Not IsError(userLookupResult) And Not IsError(passLookupResult) Then
        If passLookupResult = inputPassword Then
Login
                Worksheets(4).Range("D45").Value = txtUsername
                ActiveCell.Offset(0, -2).Select

        Else
            MsgBox "Login failed Username or Password Incorrect."
        End If
    Else
        MsgBox "Login failed Username or Password Incorrect."
    End If
           Unload Me
End Sub

 

[dmt32]

Hi,
Add the additional addresses in the Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("B5,D45,L30")) Is Nothing Then
    frmInitials.Show
   End If
End Sub

and update your submit code from fixed address to ActiveCell

'Login
               With ActiveCell
                    .Value = txtUsername
                    .Offset(0, -2).Select
                End With

Hopefully, changes will do what you want

Dave

 

[saxon25]

Hi dmt32

thanks for that worked great am still learning but getting there very slowly.

 

[dmt32]

welcome - appreciate the feedback

Dave