What do you mean by "the patients menu isn't working anymore"
I've looked at the patients form
1. I can't see why you need to have a Procedure instead of just placing the code in the button on the form
2. Your code refers to a sheet that doesn't exist - data, it should be current. In fact it does this in other Procedures
3. You use With .....End With, this means you don't have to fully qualify the object each time you refer to it, but doing this means you must precede references for the object with a "."
'wrong, note Rows,Count
lLastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
'correct
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
3. Your sort code sorts only Column A, so the data will not match, you need to sort the Table
Option Explicit
Private Sub cmdOK_Click()
Dim rPatient As Range
Dim lLastRow As Long
Dim lCalc As Long
'change Application to speed up code
With Application
.ScreenUpdating = False
lCalc = .Calculation
.Calculation = xlCalculationManual
On Error GoTo exit_proc
With current
Set rPatient = .Cells(1, 1).CurrentRegion
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lLastRow, 1).Value = Me.txtPatient.Value
Set rPatient = .Cells(1, 1).CurrentRegion
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=rPatient.Columns(1) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
With current.Sort
.SetRange rPatient
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
With current
ThisWorkbook.Names.Add Name:="patients", RefersTo:="=Patients!" & _
.Range("A2:A" & .Cells(Rows.Count, _
"A").End(xlUp).Row).Address
End With
With txtPatient
.Text = ""
.SetFocus
End With
'restore application
exit_proc:
.ScreenUpdating = True
.Calculation = lCalc
End With
End Sub
Bookmarks