Copy and paste one row from filtered table as new a new row, always in row 3, to protected worksheet

SonntagC

New Member
Joined
Mar 7, 2019
Messages
2
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
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

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