Copy cells based on value from textbox in userform

K1600

Board Regular
Joined
Oct 20, 2017
Messages
166
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:

VBA Code:
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.
 

Some videos you may like

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
In this part of your code
VBA 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

Board Regular
Joined
Oct 20, 2017
Messages
166
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

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
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

Board Regular
Joined
Oct 20, 2017
Messages
166

ADVERTISEMENT

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

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
I have slightly revised and commented your existing code. I think this is what you are looking for.
VBA Code:
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

Board Regular
Joined
Oct 20, 2017
Messages
166
That seems to have done the trick perfectly. Thank you so much.

Cheers, Glynn
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
Glad it works. You're welcome and thanks for letting me know.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,107
Messages
5,622,782
Members
415,927
Latest member
vedasinternational

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top