I have been trying to work on creating a macro to keep our patient information updated at work. We have 2 MDs and our patients change daily. The doctors have no need to know the other ones patients so I was wanting to take the combined form that the nurses use and separate it out by Doctor just for them. The building has 2 units (both units have a separate excel sheet, sheet1 and sheet2 with both MDs on both sheets). I was wanting to designate rows 1-10 for 1 unit and rows 14-25 for the other unit and create 2 new sheets, one for each MD that combines their patients to one sheet but still separates it based on what unit the patient is on. The macro would also need to not only combine the patients but delete the ones who are discharged and deleted from the original sheets. As of right now all I can do is separate the MDs patients with the following:
Sub CopyUT()
Dim bottomA As Integer
Dim x As Integer
bottomA = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row: x = 1
Dim c As Range
For Each c In Sheets("sheet1").Range("A1:A" & bottomA)
If c.Value = "UT" Then
c.EntireRow.copy Worksheets("sheet2").Range("A" & x)
x = x + 1
End If
Next c
Call CopyWC
End Sub
Sub CopyWC()
Dim bottomA As Integer
Dim x As Integer
bottomA = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row: x = 1
Dim c As Range
For Each c In Sheets("sheet1").Range("A1:A" & bottomA)
If c.Value = "WC" Then
c.EntireRow.copy Worksheets("sheet3").Range("A" & x)
x = x + 1
End If
Next c
End Sub
Also if possible, anytime new information is entered into the MD column, it would be great to have the macro automatically run to keep their forms constantly updated. If this is possible great but If not I'll work with what I can. All and any help is appreciated.
Ryan
Sub CopyUT()
Dim bottomA As Integer
Dim x As Integer
bottomA = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row: x = 1
Dim c As Range
For Each c In Sheets("sheet1").Range("A1:A" & bottomA)
If c.Value = "UT" Then
c.EntireRow.copy Worksheets("sheet2").Range("A" & x)
x = x + 1
End If
Next c
Call CopyWC
End Sub
Sub CopyWC()
Dim bottomA As Integer
Dim x As Integer
bottomA = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row: x = 1
Dim c As Range
For Each c In Sheets("sheet1").Range("A1:A" & bottomA)
If c.Value = "WC" Then
c.EntireRow.copy Worksheets("sheet3").Range("A" & x)
x = x + 1
End If
Next c
End Sub
Also if possible, anytime new information is entered into the MD column, it would be great to have the macro automatically run to keep their forms constantly updated. If this is possible great but If not I'll work with what I can. All and any help is appreciated.
Ryan