I have a protected spreadsheet of "high volume" users of the Emergency Room. These folks have many visits throughout the year. I need the user to be able to filter existing records by selecting a previous. patient. the filtered data returned should be sorted by patient name and most recent visit date (descending date order). Then allow them to copy the most recent visit as a new row into row 3, and turn off the filter. That way they are always working at the top of the worksheet (no need for scrolling).
this code i have so far inserts a new blank line (which is also something they may want to do). But i'm not sure how to do the "copy" of existing record code.
Sub ED_Discharge_InsertRow(bInsertOnly As Boolean)
Sheets("ED Discharges").Unprotect Password:="xxxxx"
If bInsertOnly Then
Else
'user will already have filtered existing data to show 1 to x of patients previous visits
'button with macro will copy table rows of most recent visit
'Calls_Copy_Discharge_Key (1)
End If
Application.ScreenUpdating = False
'insert a new row
Range("A3").Select
Selection.ListObject.ListRows.Add (1)
'grab whole row below new row and copy info into new row; doing this to make sure formulas & etc. gets copied
'data in row 4 is typically not the patient info needed.
Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("A4:AR4").Select
Selection.Copy
Range("A3").Select
ActiveSheet.Paste
If bInsertOnly Then
'clear cells except formulas to keep
Range("C3:K3").Select
Application.CutCopyMode = False
Selection.ClearContents
'clear cells except formulas to keep
Range("M3:AB3").Select
Application.CutCopyMode = False
Selection.ClearContents
Else
'paste copy most recent record of filtered patient into row 3 as new ER visit;
'allow user to update fields that are different from last visit
End If
'assign the correct index number
Range("B3").Value = Range("E1") + 1
Sheets("ED Discharges").Protect Password:="xxxxx", _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False, _
UserInterfaceOnly:=False, _
AllowFormattingCells:=False, _
AllowFormattingColumns:=False, _
AllowFormattingRows:=False, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=False
Application.ScreenUpdating = True
Range("C3").Select
End Sub
this code i have so far inserts a new blank line (which is also something they may want to do). But i'm not sure how to do the "copy" of existing record code.
Sub ED_Discharge_InsertRow(bInsertOnly As Boolean)
Sheets("ED Discharges").Unprotect Password:="xxxxx"
If bInsertOnly Then
Else
'user will already have filtered existing data to show 1 to x of patients previous visits
'button with macro will copy table rows of most recent visit
'Calls_Copy_Discharge_Key (1)
End If
Application.ScreenUpdating = False
'insert a new row
Range("A3").Select
Selection.ListObject.ListRows.Add (1)
'grab whole row below new row and copy info into new row; doing this to make sure formulas & etc. gets copied
'data in row 4 is typically not the patient info needed.
Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
Range("A4:AR4").Select
Selection.Copy
Range("A3").Select
ActiveSheet.Paste
If bInsertOnly Then
'clear cells except formulas to keep
Range("C3:K3").Select
Application.CutCopyMode = False
Selection.ClearContents
'clear cells except formulas to keep
Range("M3:AB3").Select
Application.CutCopyMode = False
Selection.ClearContents
Else
'paste copy most recent record of filtered patient into row 3 as new ER visit;
'allow user to update fields that are different from last visit
End If
'assign the correct index number
Range("B3").Value = Range("E1") + 1
Sheets("ED Discharges").Protect Password:="xxxxx", _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False, _
UserInterfaceOnly:=False, _
AllowFormattingCells:=False, _
AllowFormattingColumns:=False, _
AllowFormattingRows:=False, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=False
Application.ScreenUpdating = True
Range("C3").Select
End Sub