Copy cells based on value from textbox in userform

[K1600]

I have a userform which is a username/password login form which validates a persons login details from a read-only spreadsheet based on a hidden worksheet ("Admin Users") in a 2nd spreadsheet. The coding for that is all working find however I am now trying to make it so that once it has verified that the username and password are valid, that it copies that persons authorities from the "Admin Users" worksheet into the 1st spreadsheet on a duplicate worksheet named "Temp Admin Users" so that the authorities can be referred to whilst they are still logged in.

I currently have the following code (edited as contains company details) but I can't seem to get it to do the copy/paste:

Private Sub CMD_Login_Click()

'Ensures PIN is entered as 5 digits
If Len(TxtPIN.value) <> 5 Then
    MsgBox "PIN must be 5 digits.", vbCritical
    Exit Sub
End If

Set wbk = Workbooks.Open("\\****\Returns v.2.0.xlsx", ReadOnly:=True)

Dim targetSh As Worksheet  ' NEW TEST CODE
Set targetSh = ThisWorkbook.Worksheets("Temp Admin Users")  ' NEW TEST CODE

    UserName = TxtPIN.value
    PW = TxtPassword.value
    
    Set rngUser = wbk.Sheets("Admin Users").Range("A:B").Find(UserName, , , xlWhole, , , False, , False)
    If Not rngUser Is Nothing Then
        If (PW = rngUser.Offset(0, 1).value) And rngUser.Offset(0, 11).value = "Yes" Then
            TxtUsers.Text = wbk.Sheets("Data").Range("AI2")
            TxtTotalTests.Text = wbk.Sheets("Data").Range("AJ2")
            wbk.Close False
            TxtPassword.value = ""
    '--------------- TEST CODE START ---------------
            Dim i As Long
            For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
                If Cells(i, 1).value = TxtPIN.value Then
                    Range(Cells(i, 1), Cells(i, 29)).Copy Destination:=targetSh.Range("A" & targetSh.Cells(Rows.Count, "A").End(xlUp).Row + 1)
                End If
            Next i
    '---------------  TEST CODE END  ---------------
            UsrFrmAdminLogin.Hide
            UsrFrmAdminDashboard.Show
        Else
            MsgBox "Either your account access has not been approved or you have entered an incorrect password!", vbOKOnly, "Returns - Admin Dashboard"
            TxtPIN.value = ""
            TxtPassword.value = ""
            TxtPIN.SetFocus
            Exit Sub
        End If
    Else
        MsgBox "You are not authorised to use this system!", vbExclamation, "Returns - Admin Dashboard"
        TxtPIN.value = ""
        TxtPassword.value = ""
        Exit Sub
    End If
'---------------  TEST CODE END  ---------------
End Sub

Thanks in advance.

 

[GWteB]

In this part of your code

    '--------------- TEST CODE START ---------------
            Dim i As Long
            For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
                If Cells(i, 1).value = TxtPIN.value Then
                    Range(Cells(i, 1), Cells(i, 29)).Copy Destination:=targetSh.Range("A" & targetSh.Cells(Rows.Count, "A").End(xlUp).Row + 1)
                End If
            Next i
    '---------------  TEST CODE END  ---------------

your code searches for the "UserName / TxtPIN.Value" on the active worksheet. Which worksheet this is is not defined. The worksheet that was previously active according to your code is part of a now closed workbook due to the wbk.Close False two lines above it.

 

[K1600]

Evening, thanks for the reply.

Sorry I am not too sure of what you mean although I think you might be saying that the workbook I need is closed. To clarify the bit of code between the 'test code start' and 'test code end' points is what I have tried to add to make it do what I want. The rest of the coding I already had in place and was working fine.

The user currently opens a read only file (workbook 1) and this on opening forces the login UserForm to load. The user enters their user name and password and when they click 'Login' it opens workbook 2 and checks a sheet named 'Admin Users' to see if their user name exists and if it does, that the password matches and if so it lets them in and loads the 'Admin Dashboard' UserForm, after which Workbook 2 is closed.

What I now want it to do is after it has logged them in and whilst workbook 2 is still open, I want to copy the row (columns A:AC) containing their user name (the same row it has just checked the password on) from workbook 2 and to paste it into a sheet named "Temp Admin Users" in the read only file (workbook 1). The reason for this is that all their permissions which are used throughout their time logged in are included on the 'Admin Users' sheet in workbook 2 and I don't want to have to keep opening it each time it needs to check for a permission. If I can get it to copy/paste across then I can refer to it directly within workbook 1 and when they log out the pasted information will clear as it is only open as read only.

Hopefully that makes some kind of sense and explains a bit more what I am trying to achieve.

Thanks.

 

[GWteB]

Sorry I am not too sure of what you mean although I think you might be saying that the workbook I need is closed.

That's what I mean, so put the wbk.Close SaveChanges:=False beneath your test fragment and see if that works.

 

[K1600]

That's what I mean, so put the wbk.Close False beneath your test fragment and see if that works.

I get what you mean now. I have just tried moving the wbk.Close SaveChanges:=False to below my new code but it still doesn't work. I have stepped through the code and it seems to run through the new bit of code between For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row & Next i 12 times before then moving on to wbk.Close False. I'm not too sure why 12 though as I thought this might be copy/pasting each cell but if that were the case then it should loop through 29 times?

Sorry if I'm being a bit thick with this one.

 

[GWteB]

I have slightly revised and commented your existing code. I think this is what you are looking for.

Private Sub CMD_Login_Click()

    ' some declarations
    Dim wbk         As Workbook
    Dim targetSh    As Worksheet
    Dim UserName    As String
    Dim rngUser     As Range
    Dim rngSource   As Range    ' <<<<<<<< newly added

    'Ensures PIN is entered as 5 digits
    If Len(TxtPIN.Value) <> 5 Then
        MsgBox "PIN must be 5 digits.", vbCritical
        Exit Sub
    End If

    Set wbk = Workbooks.Open("\\****\Returns v.2.0.xlsx", ReadOnly:=True)

    Set targetSh = ThisWorkbook.Worksheets("Temp Admin Users")  ' NEW TEST CODE

    UserName = TxtPIN.Value
    PW = TxtPassword.Value

    Set rngUser = wbk.Sheets("Admin Users").Range("A:B").Find(UserName, , , xlWhole, , , False, , False)

    If Not rngUser Is Nothing Then

        Set rngSource = Range(rngUser, rngUser.Offset(0, 28)) ' <<<<<<<<
        
'rngSource.Select       <<<<<< uncomment this line in debug mode to ensure this is what you expect

        If (PW = rngUser.Offset(0, 1).Value) And rngUser.Offset(0, 11).Value = "Yes" Then
            TxtUsers.Text = wbk.Sheets("Data").Range("AI2")
            TxtTotalTests.Text = wbk.Sheets("Data").Range("AJ2")

'wbk.Close False  '     <<<<<< closed too early

            TxtPassword.Value = ""
            
''    '--------------- TEST CODE START ---------------
''
''    >>>>>> unnecessary now because of rngSource <<<<<<
''
''            Dim i As Long
''            For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
''                If Cells(i, 1).Value = TxtPIN.Value Then
''                    Range(Cells(i, 1), Cells(i, 29)).Copy Destination:=targetSh.Range("A" & targetSh.Cells(Rows.Count, "A").End(xlUp).Row + 1)
''                End If
''            Next i
''    '---------------  TEST CODE END  ---------------

            ' perform copy              <<<<<<<<<
            rngSource.Copy Destination:=targetSh.Range("A" & targetSh.Cells(Rows.Count, "A").End(xlUp).Row + 1)
            
            ' close source workbook     <<<<<<<<<
            wbk.Close Savechanges:=False
            Set wbk = Nothing

            UsrFrmAdminLogin.Hide
            UsrFrmAdminDashboard.Show
        Else
            MsgBox "Either your account access has not been approved or you have entered an incorrect password!", vbOKOnly, "Returns - Admin Dashboard"
            TxtPIN.Value = ""
            TxtPassword.Value = ""
            TxtPIN.SetFocus
            Exit Sub
        End If
    Else
        MsgBox "You are not authorised to use this system!", vbExclamation, "Returns - Admin Dashboard"
        TxtPIN.Value = ""
        TxtPassword.Value = ""
        Exit Sub
    End If
    '---------------  TEST CODE END  ---------------
    
    ' ensure source workbook is closed  <<<<<<<<<<
    If Not wbk Is Nothing Then
        wbk.Close Savechanges:=False
        Set wbk = Nothing
    End If

    ' clean up                          <<<<<<<<<<
    Set targetSh = Nothing
    Set rngUser = Nothing
    Set rngSource = Nothing

End Sub

 

[K1600]

That seems to have done the trick perfectly. Thank you so much.

Cheers, Glynn

 

[GWteB]

Glad it works. You're welcome and thanks for letting me know.