VBA Userform button

[Doug Mutzig]

Good afternoon all,

I am just starting with userforms and have run into some roadblocks. I have a userform, table on a data tab, and then a replicated form on another tab. The end user will use the form to enter data that is stored in the table and then the cells of the table are linked to the replicated form. I have a macro button to open the form, a button for a new record with some standard/default info, a button to save the data, and a close form button. The roadblocks I have are:
1. How do I get the userform to display the first row of data when opening?
2. How to I setup buttons for next and previous?
3. Since I am using linked cells deleting the table row causes issues, is there a way to set a button to just delete the data in the cells and then perform a sort on the table based on the first column (room)?
4. I also have a list box that shows the current room numbers, is there a way to double click on a room and show it's data in the form?

Data Table (T_Data)

Userform (Patient Data Entry Form)

Replicated form (the top area is for entering other information with the bottom set in a format the staff is used to viewing

My current code:

Option Explicit
  Dim nCurrentRow As Long
  Dim ws As Worksheet
  Dim FBR As Long 'FBR = First Blank Row
  

Private Sub ActiveRooms_Click()
    Dim rng As Range
    
    Set rng = Worksheets("Data").Range("A2:BD100")
    
    If ActiveRooms.ListIndex <> -1 Then
    
    End If
End Sub

Private Sub cmdSave_Click()
    
    Set ws = Worksheets("Data")

      With ws

        'find first empty row in data worksheet
        FBR = .Cells.Find(what:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

            'copy the data to the data worksheet. Use protect and unprotect lines if worksheet is protected
            
            '  .Unprotect Password:="password"
                .Cells(FBR, 1).Value = Me.RoomNumber.Value
                .Cells(FBR, 2).Value = Me.TPMDue.Value
                .Cells(FBR, 3).Value = Me.JOB.Value
                .Cells(FBR, 4).Value = Me.FullName.Value
                .Cells(FBR, 5).Value = Me.FMP.Value
                .Cells(FBR, 6).Value = Me.Grade.Value
                .Cells(FBR, 7).Value = Me.Sex.Value
                .Cells(FBR, 8).Value = Me.Age.Value
                .Cells(FBR, 9).Value = Me.Provider.Value
                .Cells(FBR, 10).Value = Me.SocialWorker.Value
                .Cells(FBR, 11).Value = Me.AdmitDate.Value
                .Cells(FBR, 12).Value = Me.Unit.Value
                .Cells(FBR, 13).Value = Me.TIS.Value
                .Cells(FBR, 14).Value = Me.Dx.Value
                .Cells(FBR, 15).Value = Me.Falls.Value
                .Cells(FBR, 16).Value = Me.Status.Value
                .Cells(FBR, 17).Value = Me.Allergies.Value
                .Cells(FBR, 18).Value = Me.Med01_Name.Value
                .Cells(FBR, 19).Value = Me.Med01_Dose.Value
                .Cells(FBR, 20).Value = Me.Med01_Time.Value
                .Cells(FBR, 21).Value = Me.Med02_Name.Value
                .Cells(FBR, 22).Value = Me.Med02_Dose.Value
                .Cells(FBR, 23).Value = Me.Med02_Time.Value
                .Cells(FBR, 24).Value = Me.Med03_Name.Value
                .Cells(FBR, 25).Value = Me.Med03_Dose.Value
                .Cells(FBR, 26).Value = Me.Med03_Time.Value
                .Cells(FBR, 27).Value = Me.Med04_name.Value
                .Cells(FBR, 28).Value = Me.Med04_Dose.Value
                .Cells(FBR, 29).Value = Me.Med04_Time.Value
                .Cells(FBR, 30).Value = Me.Med05_name.Value
                .Cells(FBR, 31).Value = Me.Med05_Dose.Value
                .Cells(FBR, 32).Value = Me.Med05_Time.Value
                .Cells(FBR, 33).Value = Me.Med06_Name.Value
                .Cells(FBR, 34).Value = Me.Med06_Dose.Value
                .Cells(FBR, 35).Value = Me.Med06_Time.Value
                .Cells(FBR, 36).Value = Me.Med07_Name.Value
                .Cells(FBR, 37).Value = Me.Med07_Dose.Value
                .Cells(FBR, 38).Value = Me.Med07_Time.Value
                .Cells(FBR, 39).Value = Me.Med08_Name.Value
                .Cells(FBR, 40).Value = Me.Med08_Dose.Value
                .Cells(FBR, 41).Value = Me.Med08_Time.Value
                .Cells(FBR, 42).Value = Me.Med09_name.Value
                .Cells(FBR, 43).Value = Me.Med09_Dose.Value
                .Cells(FBR, 44).Value = Me.Med09_Time.Value
                .Cells(FBR, 45).Value = Me.Med10_Name.Value
                .Cells(FBR, 46).Value = Me.Med10_Dose.Value
                .Cells(FBR, 47).Value = Me.Med10_Time.Value
                .Cells(FBR, 48).Value = Me.DoDSER.Value
                .Cells(FBR, 49).Value = Me.Branch.Value
                .Cells(FBR, 50).Value = Me.SpecialNotes.Value
                .Cells(FBR, 51).Value = Me.MissingItems.Value
                .Cells(FBR, 52).Value = Me.AdmitNotes.Value
                .Cells(FBR, 53).Value = Me.PsychHx.Value
                .Cells(FBR, 54).Value = Me.MedHx.Value
                .Cells(FBR, 55).Value = Me.PrevShift.Value
                .Cells(FBR, 56).Value = Me.EstDischarge.Value
             '  .Protect Password:="password"
     End With

    cmdNew_Click

End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub cmdNew_Click()
  With Me
    .RoomNumber.ListIndex = 0
    .TPMDue.Value = ""
    .JOB.Value = ""
    .FullName.Value = ""
    .FMP.Value = ""
    .Grade.ListIndex = 0
    .Sex.ListIndex = 0
    .Age.Value = ""
    .Provider.ListIndex = 0
    .SocialWorker.ListIndex = 0
    .AdmitDate.Value = ""
    .Unit.Value = ""
    .TIS.Value = ""
    .Dx.Value = ""
    .Falls.ListIndex = 0
    .Status.ListIndex = 0
    .Allergies.Text = "NKDA"
    .Med01_Name.Text = "Tylenol"
    .Med01_Dose.Text = "650mg"
    .Med01_Time.Text = "Q6 PRN"
    .Med02_Name.Text = "Maalox"
    .Med02_Dose.Text = "30ml"
    .Med02_Time.Text = "Q3 PRN"
    .Med03_Name.Text = "Milk of Magnesia (MoM)"
    .Med03_Dose.Text = "30ml"
    .Med03_Time.Text = "Q6 PRN"
    .Med04_name.Text = "Nicotine Gum"
    .Med04_Dose.Text = "2mg"
    .Med04_Time.Text = "Q2 Prn"
    .Med05_name.Text = "Hydroxyzine"
    .Med05_Dose.Text = "50mg"
    .Med05_Time.Text = "QHS PRN"
    .Med06_Name.Value = ""
    .Med06_Dose.Value = ""
    .Med06_Time.Value = ""
    .Med07_Name.Value = ""
    .Med07_Dose.Value = ""
    .Med07_Time.Value = ""
    .Med08_Name.Value = ""
    .Med08_Dose.Value = ""
    .Med08_Time.Value = ""
    .Med09_name.Value = ""
    .Med09_Dose.Value = ""
    .Med09_Time.Value = ""
    .Med10_Name.Value = ""
    .Med10_Dose.Value = ""
    .Med10_Time.Value = ""
    .DoDSER.ListIndex = 0
    .Branch.ListIndex = 0
    .SpecialNotes.Value = ""
    .MissingItems.Value = ""
    .AdmitNotes.Value = ""
    .PsychHx.Value = ""
    .MedHx.Value = ""
    .PrevShift.Value = ""
    .EstDischarge.Value = ""
        
 End With
End Sub


Private Sub UserForm_Click()

End Sub

Any help you guidance you can provide would be greatly appreciated!
Doug

 

[DanteAmor]

Check the following proposal.

1. You have 56 fields in your userform, the proposal is to have all the fields on a sheet (SetUp), that way we could reduce the code considerably.
2. Create a sheet called "SetUp" and fill it with the following data:

varios 14jul2020.xlsm
	A	B	C	D
1	Column	Field	Initial Value	TypeName
2	1	RoomNumber		ComboBox
3	2	TPMDue		TextBox
4	3	JOB		TextBox
5	4	FullName		TextBox
6	5	FMP		TextBox
7	6	Grade		ComboBox
8	7	Sex		ComboBox
9	8	Age		TextBox
10	9	Provider		ComboBox
11	10	SocialWorker		ComboBox
12	11	AdmitDate		TextBox
13	12	Unit		TextBox
14	13	TIS		TextBox
15	14	Dx		TextBox
16	15	Falls		ComboBox
17	16	Status		ComboBox
18	17	Allergies	NKDA	TextBox
19	18	Med01_Name	Tylenol	TextBox
20	19	Med01_Dose	650mg	TextBox
21	20	Med01_Time	Q6 PRN	TextBox
22	21	Med02_Name	Maalox	TextBox
23	22	Med02_Dose	30ml	TextBox
24	23	Med02_Time	Q3 PRN	TextBox
25	24	Med03_Name	Milk of Magnesia (MoM)	TextBox
26	25	Med03_Dose	30ml	TextBox
27	26	Med03_Time	Q6 PRN	TextBox
28	27	Med04_name	Nicotine Gum	TextBox
29	28	Med04_Dose	2mg	TextBox
30	29	Med04_Time	Q2 Prn	TextBox
31	30	Med05_name	Hydroxyzine	TextBox
32	31	Med05_Dose	50mg	TextBox
33	32	Med05_Time	QHS PRN	TextBox
34	33	Med06_Name		TextBox
35	34	Med06_Dose		TextBox
36	35	Med06_Time		TextBox
37	36	Med07_Name		TextBox
38	37	Med07_Dose		TextBox
39	38	Med07_Time		TextBox
40	39	Med08_Name		TextBox
41	40	Med08_Dose		TextBox
42	41	Med08_Time		TextBox
43	42	Med09_name		TextBox
44	43	Med09_Dose		TextBox
45	44	Med09_Time		TextBox
46	45	Med10_Name		TextBox
47	46	Med10_Dose		TextBox
48	47	Med10_Time		TextBox
49	48	DoDSER		ComboBox
50	49	Branch		ComboBox
51	50	SpecialNotes		TextBox
52	51	MissingItems		TextBox
53	52	AdmitNotes		TextBox
54	53	PsychHx		TextBox
55	54	MedHx		TextBox
56	55	PrevShift		TextBox
57	56	EstDischarge		TextBox
SetUp

3. The following code considers your requests 1.display the first row, 2.buttons for next and previous and 4. Click on a room and show it's data.
4. Replace all your code with the following:

Option Explicit
  Dim ws As Worksheet, wsSet As Worksheet
  Dim n As Long
 
Private Sub ActiveRooms_Click()
  Dim i As Long, nRow As Long
  Dim ctrl As MSForms.Control
  nRow = ActiveRooms.ListIndex + 2
  For i = 2 To n
    Set ctrl = Controls(wsSet.Range("B" & i).Value)
    ctrl.Value = ws.Cells(nRow, wsSet.Range("A" & i).Value).Value
  Next
End Sub

Private Sub CmdNext_Click()
'Next Button
  With ActiveRooms
    If .ListIndex < .ListCount - 1 Then
      .Selected(.ListIndex + 1) = True
    End If
  End With
End Sub

Private Sub CmdPrev_Click()
'Previous Button
  With ActiveRooms
    If .ListIndex > 0 Then
      .Selected(.ListIndex - 1) = True
    End If
  End With
End Sub

Private Sub cmdSave_Click()
'Save Button
  Dim i As Long, lr As Long
  lr = ws.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row + 1
  For i = 2 To n
    ws.Cells(lr, wsSet.Range("A" & i).Value).Value = Controls(wsSet.Range("B" & i).Value)
  Next
  Call cmdNew_Click
End Sub

Private Sub cmdNew_Click()
'Clean Form
  Dim ctrl As MSForms.Control
  Dim i As Long, lr As Long
  For i = 2 To n
    Set ctrl = Controls(wsSet.Range("B" & i).Value)
    If TypeName(ctrl) = "ComboBox" Then
      ctrl.ListIndex = 0
    Else
      ctrl.Value = wsSet.Range("C" & i).Value
    End If
  Next
  lr = ws.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  If lr < 3 Then lr = 3
  'load list activerooms
  ActiveRooms.List = ws.Range("A2:A" & lr).Value
  ActiveRooms.Selected(0) = True
End Sub

Private Sub UserForm_Activate()
'Load Data
  Dim ctrl As MSForms.Control
  Dim i As Long, lr As Long
 
  'SET sheets
  Set ws = Worksheets("Data")
  Set wsSet = Worksheets("SetUp")
  lr = ws.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  n = wsSet.Range("B" & Rows.Count).End(3).Row   'number of fields
  'load list activerooms
  If lr < 3 Then lr = 3
  ActiveRooms.List = ws.Range("A2:A" & lr).Value
  ActiveRooms.Selected(0) = True
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub

5. "Since I am using linked cells deleting the table row causes issues."
I recommend not having the cells linked, fill out your Replicated form on the spot.
I don't know how you have the format, but you could create a macro to fill the Replicated form with a certain record, so you can delete records in the table without worrying about the Replicated form.

 

[Doug Mutzig]

Good morning Dante,

This works really well, Thank you!
I only have an issue with the cmdNew_Click as the form just goes to and displays the first record. I have created the SetUp tab as instructed and verified the field names match. Do you have any idea on what could be wrong?

I agree that the linked cells is not a good path, can you guide me in creating a delete record function please.

 

[DanteAmor]

I only have an issue with the cmdNew_Click

Change cmdNew_Click code for this:

Private Sub cmdNew_Click()
'Clean Form
  Dim ctrl As MSForms.Control
  Dim i As Long, lr As Long
  
  'load list activerooms
  lr = ws.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  If lr < 3 Then lr = 3
  ActiveRooms.List = ws.Range("A2:A" & lr).Value
  If ActiveRooms.ListIndex > -1 Then
    ActiveRooms.Selected(ActiveRooms.ListIndex) = False
  End If
  
  For i = 2 To n
    Set ctrl = Controls(wsSet.Range("B" & i).Value)
    If TypeName(ctrl) = "ComboBox" Then
      ctrl.ListIndex = 0
    Else
      ctrl.Value = wsSet.Range("C" & i).Value
    End If
  Next
End Sub

________________________________________________________________________

I agree that the linked cells is not a good path, can you guide me in creating a delete record function please.

Add this:

Private Sub CmdDelete_Click()
'Delete Button
  With ActiveRooms
    If .ListIndex = -1 Then
      MsgBox "Select a record from list"
    Else
      ws.Rows(.ListIndex + 2).Delete
    End If
  End With
  Call cmdNew_Click
End Sub

 

[Doug Mutzig]

Hi Dante,

Absolutely perfect! Thank you so much for your work on this!

 

[DanteAmor]

Glad we could help & thanks for the feedback