Transfer updated data to specific sheet from Userform

pepsiguydrinkscoke

New Member
Joined
Jul 4, 2021
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
Hi! I'm new so please forgive me if this has already been posted elsewhere. I've been researching my problem for several weeks with no luck.

I work in healthcare and I have a spreadsheet for tracking employee data at multiple clinics. The employees are assigned to a specific clinic so I have 1 document with 16 sheets, 1 sheet for each clinic, with multiple employees listed per sheet. I've created a Userform for entering the employee data and found a beautiful bit of code that helped me be able to select a specific sheet to send the data entered in the Userform to. It works flawlessly.

My issue comes in when I have to update the employee's data. My Userform contains only the data that will be transferred to the specific sheet for the location they are assigned too and as of now, it only allows me to enter data, whether it's new or repeated information. I do not have a list box in my Userform to show the data being transferred to the sheet as this didn't seem necessary for my needs. I would like to know if there is a code that will allow me to search the workbook (or a specific sheet, if that's easier) for an employees name and have their information populate on the Userform to be able to update it and save the updated data on the sheet it came from. I also have not yet added a Search Command Button as I haven't found the right code. If by some miracle there is a code I can use, I'll add the search button then.

Unfortunately, I'm not allowed to download anything to my work computer so I'm not able to use the Mini-sheet feature so I've uploaded a screenshot of my Userform as well as a view of the Sheet the data transfers over to. I will also list the code I'm using for transferring my data below in case that helps. Please let me know if there is anything more I can provide.

VBA Code:
Private Sub cmdSave_Click()
    Dim cNum As Integer
    Dim X As Integer
    Dim nextrow As Range
    Dim sht As String
    
    sht = cmbClinicNumber.Value
    
    If Me.cmbClinicNumber.Value = "" Then
        MsgBox "Please select a Clinic Number."
        Exit Sub
    End If
    
    cNum = 30
    
    Set nextrow = Sheets(sht).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    For X = 1 To cNum
        Me.Controls("Reg" & X).Value = ""
    Next
    MsgBox "Saved"
End Sub
Private Sub UserForm_Initialize()

Dim ws As Worksheet

    For Each ws In Worksheets

        Select Case ws.CodeName
        
            Case "Sheet1", "Sheet4", "Sheet20" 'Hidden Sheets
            
            Case Else
                Me.cmbClinicNumber.AddItem ws.Name
        End Select
    Next ws
With Reg3
.AddItem "X"
End With
With Reg4
.AddItem "X"
End With
With Reg5
.AddItem "X"
End With
With Reg21
.AddItem "Immune"
.AddItem "Susceptible"
End With
End Sub
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
I'm sorry - I couldn't find a way to edit my previous post. I promise I'm not trying to boost my question. I realized my code was incomplete, I've corrected it. I also noticed that my screenshots didn't attach to my previous post.

Corrected Code:
VBA Code:
Private Sub cmdSave_Click()
    Dim cNum As Integer
    Dim X As Integer
    Dim nextrow As Range
    Dim sht As String
    sht = cmbClinicNumber.Value
    If Me.cmbClinicNumber.Value = "" Then
        MsgBox "Please select a Clinic Number."
        Exit Sub
    End If
    cNum = 30
    Set nextrow = Sheets(sht).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    For X = 1 To cNum
        nextrow = Me.Controls("Reg" & X).Value
        
        Set nextrow = nextrow.Offset(0, 1)
        
    Next
    For X = 1 To cNum
        Me.Controls("reg" & X).Value = ""
    Next
    
    MsgBox "Saved"
End Sub
Private Sub UserForm_Initialize()
Dim ws As Worksheet
    For Each ws In Worksheets
        Select Case ws.CodeName
            Case "Sheet1", "Sheet4", "Sheet20" 'Hidden Sheets
            Case Else
                Me.cmbClinicNumber.AddItem ws.Name
        End Select
    Next ws
        With Reg3
        .AddItem "X"
        End With
        With Reg4
        .AddItem "X"
        End With
        With Reg5
        .AddItem "X"
        End With
        With Reg21
        .AddItem "Immune"
        .AddItem "Susceptible"
        End With
        
End Sub

EFA Userform.jpg
EFA Clinic Sheet.jpg
 
Upvote 0
Hi,

Untested, but assuming employee name in column A of each worksheet is unique, then see if following update to your code does what you want.


Rich (BB code):
Private Sub cmdSave_Click()
    Dim cNum        As Integer, X          As Integer, i As Integer
    Dim ctrl        As Variant
    Dim sht         As String, EmployeeName As String
    Dim FindEmployee As Range, nextrow    As Range
    
    On Error GoTo myerror
    'check clinic number & employee fields selected
    For Each ctrl In Array(cmbClinicNumber, txtEmployeeName)
        i = i + 1
        If i = 1 Then sht = ctrl.Value Else EmployeeName = ctrl.Value
        If Len(ctrl.Value) = 0 Then
            'inform user
            MsgBox "Please " & Choose(i, "Select Clinic Number.", "Enter Employee Name"), 48, "Entry Required"
            ctrl.SetFocus
            Exit Sub
        End If
    Next ctrl
    
    cNum = 30
    
    With ThisWorkbook.Worksheets(sht)
        'check for existing employee in range
        Set FindEmployee = .Columns(1).Find(EmployeeName, LookIn:=xlValues, lookat:=xlWhole)
        
        If Not FindEmployee Is Nothing Then
            'employee found
            Set nextrow = FindEmployee
        Else
            'new record
            Set nextrow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
        End If
    End With
    
    For X = 1 To cNum
        With Me.Controls("Reg" & X)
            'post record to range
            nextrow.Offset(, X - 1).Value = .Value
            'clear control
            .Value = ""
        End With
    Next X
    
    'inform user
    MsgBox IIf(FindEmployee Is Nothing, "New Record Saved", "Record Updated"), 64, "Success"
    
myerror:
    'report errors
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Amend txtEmployeeName control name show in BOLD as required.

Dave
 
Upvote 0
Hi,

Untested, but assuming employee name in column A of each worksheet is unique, then see if following update to your code does what you want.


Rich (BB code):
Private Sub cmdSave_Click()
    Dim cNum        As Integer, X          As Integer, i As Integer
    Dim ctrl        As Variant
    Dim sht         As String, EmployeeName As String
    Dim FindEmployee As Range, nextrow    As Range
   
    On Error GoTo myerror
    'check clinic number & employee fields selected
    For Each ctrl In Array(cmbClinicNumber, txtEmployeeName)
        i = i + 1
        If i = 1 Then sht = ctrl.Value Else EmployeeName = ctrl.Value
        If Len(ctrl.Value) = 0 Then
            'inform user
            MsgBox "Please " & Choose(i, "Select Clinic Number.", "Enter Employee Name"), 48, "Entry Required"
            ctrl.SetFocus
            Exit Sub
        End If
    Next ctrl
   
    cNum = 30
   
    With ThisWorkbook.Worksheets(sht)
        'check for existing employee in range
        Set FindEmployee = .Columns(1).Find(EmployeeName, LookIn:=xlValues, lookat:=xlWhole)
       
        If Not FindEmployee Is Nothing Then
            'employee found
            Set nextrow = FindEmployee
        Else
            'new record
            Set nextrow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
        End If
    End With
   
    For X = 1 To cNum
        With Me.Controls("Reg" & X)
            'post record to range
            nextrow.Offset(, X - 1).Value = .Value
            'clear control
            .Value = ""
        End With
    Next X
   
    'inform user
    MsgBox IIf(FindEmployee Is Nothing, "New Record Saved", "Record Updated"), 64, "Success"
   
myerror:
    'report errors
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Amend txtEmployeeName control name show in BOLD as required.

Dave
Hello Dave!

Thank you so much for your help on this! It works but isn't exactly what I was looking for. Please don't take that to mean I'm ungrateful. Truly, I wouldn't have been able to figure any of that out on my own, so, I'm deeply thankful. It's a much better code than I originally had as it allows the data to be overwritten instead of having multiple entries for the same person on a sheet. Which was something I couldn't, for my life, figure out.

I was hoping to be able to pull the data from a sheet into my Userform to be able to update the information in the Userform so that all the data doesn't need to be re-entered every time and allow the user to enter whatever item does need to be updated for that employee. Some items are only entered once, others are updated annually and others on a semi-annual basis and a lot of information could be lost if a text box in the Userform is accidentally left blank. Additionally, not every item is required for some employees, (ie: Secretaries are not required to have Licenses, CPR training or Colorblindness Tests) which is why I chose to not make every field a required one.

So, for example, the user launches the Userform, then types, say, the employee's last name in the text box and then presses the "search" command button (to be added) and the Userform searches in either the specified sheet selected from the clinic number list box or the entire workbook (no employee file is maintained at 2 locations, so whichever search is easier to code) and returns the information onto the Userform. Then, if the license expiration date needs to be updated (or any of the text fields), the user can enter the new information in the text box and press the Save button to store the info where it originally pulled the data from. Is something like this possible?

My hope is this is inspiring you, or anyone, to solve this specific and complex problem of mine rather than my being a picky, obnoxious nuisance who's asking for the impossible.

Thank you again for your help!
 
Upvote 0
Hi,

Should be able to modify the suggestion to hopefully do what you want

  • Make backup of your workbook
  • Add a commandbutton and name is cmdFind
  • Set this buttons enabled property to False
  • Delete existing cmdSave code
  • Add ALL following codes to you userforms code page
Rich (BB code):
Dim EmployeeName    As String
Dim FindEmployee    As Range
Const cNum          As Integer = 30

Private Sub txtEmployeeName_Change()
    EmployeeName = Me.txtEmployeeName.Value
    Me.cmdFind.Enabled = Len(EmployeeName) > 0
End Sub

Private Sub cmdSave_Click()
    Dim x           As Integer, i As Integer
    Dim ctrl        As Variant
    Dim sht         As String
    Dim nextrow     As Range
    
    
    On Error GoTo myerror
    'check clinic number & employee fields selected
    For Each ctrl In Array(cmbClinicNumber, txtEmployeeName)
        i = i + 1
        If i = 1 Then sht = ctrl.Value Else EmployeeName = ctrl.Value
        If Len(ctrl.Value) = 0 Then
            'inform user
            MsgBox "Please " & Choose(i, "Select Clinic Number.", "Enter Employee Name"), 48, "Entry Required"
            ctrl.SetFocus
            Exit Sub
        End If
    Next ctrl
    
        If Not FindEmployee Is Nothing Then
            'employee update
            Set nextrow = FindEmployee
        Else
            With ThisWorkbook.Worksheets(sht)
            'new record
            Set nextrow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
            End With
       End If

    For x = 1 To cNum
        With Me.Controls("Reg" & x)
            'post record to range
            nextrow.Offset(, x - 1).Value = .Value
            'clear control
            .Value = ""
        End With
    Next x
    
    'inform user
    MsgBox IIf(FindEmployee Is Nothing, "New Record Saved", "Record Updated"), 64, "Success"
    
    Set FindEmployee = Nothing
    Me.cmdSave.Caption = "Save"
    
myerror:
    'report errors
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Private Sub cmdFind_Click()
    Dim x       As Integer
    Dim ws      As Worksheet
    
    On Error GoTo myerror
    
    For Each ws In ThisWorkbook.Worksheets
        'check for existing employee in range
        Set FindEmployee = ws.Columns(1).Find(EmployeeName, LookIn:=xlValues, lookat:=xlWhole)
        If Not FindEmployee Is Nothing Then
            For x = 1 To cNum
                Me.Controls("Reg" & x).Value = FindEmployee.Offset(, x - 1).Value
            Next x
            Me.cmdSave.Caption = "Update"
            Me.cmbClinicNumber.Value = ws.Name
            Exit For
        End If
   Next ws
   
    If FindEmployee Is Nothing Then Err.Raise 744
    
myerror:
    'report errors
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Note 1 variables shown at the top – these variables MUST sit ate very TOP of your forms code page OUTSIDE any procedure

Note 2 Rename control shown in BOLD as required

solution note fully tested & should be adjusted to meet specific project need as required.

Dave
 
Upvote 0
Solution
Oh Thank you, Thank you, Thank you! Dave - You're an absolute genius! This is PERFECT and exactly what I needed. You have no idea what this means to me. I don't even have words. It's beautiful and you've saved me so much time, not just in trying to figure this out but all the days and hours ahead of me I would have spent manually entering this information for over 300 employees. I am absolutely adding your name as credit for this gorgeous code on my userform, as a reminder of your generous assistance with this beast that's been thwarting me for weeks now. I'm envious that you were able to create this so quickly and so grateful for your help. I truly can't thank you enough.

Wishing you all the best!
Tara
 
Upvote 0
Hi,
glad update does what you want & many thanks for your very generous feedback which is very much appreciated.

good luck with your project

Dave
 
Upvote 0

Forum statistics

Threads
1,214,832
Messages
6,121,844
Members
449,051
Latest member
excelquestion515

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
Back
Top