Search/Transfer Patient DataClosed

Question

Hello, 
If anyone could help me, it would be greatly appreciated. 
Ok I have a spreadsheet with different patient names. If they are inpatient then there is a column that is blank. Once they are discharged, that blank space is filled with a date. SO what I Need daily is for it to give me a list of the patient names that are still here (blank spaces. I am at a complete loss; Thanks so much for taking your time to help me!



Configuration: Windows 7 / Mozilla 11.0

vcoolio · Answer

Hello Turtleann2005,

Perhaps the following VBA code may start you off in the right direction:-

Sub FindInpatients()

Dim lr As Long

Application.ScreenUpdating = False

Sheet1.Range("H2", Sheet1.Range("H" & Sheet1.Rows.Count).End(xlUp)(2)).ClearContents

lr = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
        Sheet1.Range("B1:B" & lr).AutoFilter 1, ""
        If lr > 1 Then
        Sheet1.Range("A2:A" & lr).Copy
        Sheet1.Range("H" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
        End If
Sheet1.[B1].AutoFilter

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub



Not knowing how your work book is set out, I've had to assume that you are dealing with two columns of data only (say Columns A & B) and that the result is placed in Column H (this can be changed to suit of course).

Following is the link to my test work book for you to peruse:-

https://www.dropbox.com/s/bfs2648yk6nwjwc/Turtleann2005%28CopyPaste%20range%2Cautofilter%29.xlsm?dl=0

The code filters Column B for blank date cells and when found will transfer the patient name to Column H in the same sheet.

Add or delete data as you like (or just use the sample as is) in the test work book then click on the "RUN" button to see it work.

I hope that this helps.

Cheerio,
vcoolio.

vcoolio · Answer

Hello Turtleann,

You can upload a sample of your work book to a free file sharing site such as DropBox, ge.tt or SpeedyShare and then post the link to your file back here (just like I did in my first reply to you). 
Please be careful with any sensitive data and preferably use dummy data.

Cheerio,
vcoolio.

turtleann2005 · Answer

http://ge.tt/7B9XsEe2

Please help me. Thanks in advance!

OK here is the link to my new workbook. I think I got the code now. If you don't mind can you double check. However,  I have a few other issues if you could help me. You have been so helpful already and I thank you profusely. 

So, the patients who haven't discharged have the blank which will populate their name. I need it to populate on the first sheet labeled Patient Census. I also need it to update each day, while still saving the day before on there as well. That way we can look back and say, oh that person was still here that day. Does that make sense?

Then, from those names that populate daily I need to calculate a month total of people served at the end. Minus the duplicate names as some people stay for up to 2 weeks. 

Lastly, I need to be able say 3 people are still here from august, I need them to carry forward to the list for September. 

I know its a lot. But thank u! So much I really appreciate this. 


Hopefully this is what u were asking, if not let me know!

vcoolio · Answer

Hello Turtleann,

We have a problem (sounds familiar!). The download was blocked by my security programme as being unsafe. It may have picked up a bug along the way as free file sharing sites are targeted by morons who have nothing better to do.

Please try DropBox and we'll see what happens from there.

Cheerio,
vcoolio.

Turtleann2005 · Answer

https://www.dropbox.com/s/we63lan0ub6wck7/Help%20me%20please.xlsx?dl=0

Hopefully this works. THanks again!

vcoolio · Answer

Hello Turtleann,

I don't see a Patient Census sheet but there is a Daily Census sheet. Is this the sheet you mean?

Cheerio,
vcoolio.

vcoolio · Answer

Hello Turtleann,

I'm struggling to understand the logic behind the set out of the Daily Census sheet. There is a myriad of formulae and drop-downs spread across the sheet with no apparent order. Any VBA code would need to be unnecessarily involved to hurdle the obstacles.

Would you be open to suggestions to make your work book a more seamless, easy-to-follow structure?

Cheerio,
vcoolio.

vcoolio · Answer

Hello Turtleann,


Following is the link to my sample work book:-

https://www.dropbox.com/s/5f7e9ew6efn3jkw/Turtleann%28Multi%20shts%20to%20Master%20sht%29.xlsm?dl=0

You'll notice that it is somewhat different to the one that you supplied. 

I have assumed that you will require a sheet for each month hence, in the sample work book, there is a "Patient Census" sheet and twelve monthly sheets. The monthly sheets are all set out the same. The only data is in sheets Aug and Sept (just following on from your sample).

In the Patient Census sheet, all headings are the same as the monthly sheets as I had assumed that you would like to see all data associated with a patient at a glance. I have placed all the "counters" at the top of the sheet so that you won't have to scroll to the bottom of the sheet each time you need to check this data. You can re-format all this to suit yourself.
Click on the "Today's Patients" button to transfer the relevant data from each sheet on a daily basis ( or whenever you choose to).

 You will also notice that in all sheets I have added a "Patient ID" column. The reason for this is that this will give each patient a unique ID just in case you have patients with identical names. This is also a simpler method for identifying duplicates and removing them in the Patient Census sheet. I have just made up the Patient IDs so you can change these to suit yourself.

Finally, you'll notice that there is a "Transfer Previous" button on each monthly sheet. Click on this button to bring the previous month's patient data to the current month as per your request. This will only happen if there isn't a discharge date  in Column G of the previous month.

The codes to execute the above are as follows:-

Sub FindInpatients()

Dim lr As Long
Dim ws As Worksheet

Application.ScreenUpdating = False

For Each ws In Worksheets
    If ws.Name <> "Patient Census" Then
With ws.Range("G1", ws.Range("G" & ws.Rows.Count).End(xlUp))
        .AutoFilter 1, ""
        On Error Resume Next
        .Offset(1).EntireRow.Copy
        Sheet1.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
        Sheet1.Columns.AutoFit
        End With
ws.AutoFilterMode = False
        End If
Next ws

Sheet1.Range("A5:I" & Rows.Count).RemoveDuplicates Columns:=3, Header:=xlYes
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Sub TransferPrevious()

Dim lr As Long
Dim c As Range
lr = Range("I" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False

ActiveSheet.Previous.Select

For Each c In Range("G2:G" & lr)
  If c.Value = "" Then
    c.EntireRow.Copy
      ActiveSheet.Next.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
       ActiveSheet.Next.Columns.AutoFit
      End If
Next c

Application.CutCopyMode = False
Application.ScreenUpdating = True
ActiveSheet.Next.Select

End Sub

I have not included any formulae (other than the "counters" at the top of the Patient Census sheet) or drop down boxes in my sample work book. I'll leave this to you.

I hope that this helps.

Cheerio,
vcoolio.

turtleann2005 · Answer

For some reason when I click today's patients, only the one from yesterday and not today is showing up. Can u please help me? One last time. Thanks so much

vcoolio · Answer

Hi Turtleann,

Is this happening when you run the code after downloading the DropBox sample or when you run it from your own work book?

What version of Excel are you using?

Based on the sample that you supplied, only two entries should be transferring across to the Patient Census sheet. One from August (Betty Lou Who) and one from September (Mickey Mouse) as these are the only entries that do not have discharge dates against them.

What do you see in the Patient Census sheet once you click on the button?

Cheerio,
vcoolio.

vcoolio · Answer

Hello again Turtleann,


There have been issues (for me at least) with Posters downloading files from DropBox so I have uploaded the file to Box.com and following is the link:-

https://app.box.com/s/r5qffgq781t0o5xeuegqc230zsaaehcs

See if all works as it should from the above link.

You may notice that I have made a couple of subtle changes:-

1) To the code (amended below).
2) I have removed the button from the "Jan" sheet.

The reason for (2) above is that I am assuming that you will use the work book as a template so that you can use it year after year. Hence, once you come to the end of December, you will manually have to bring any December "stragglers" over to the "Jan" tab for the new year and then archive the previous year's work book in case you will ever need to refer to it again.

Following is the code again with the subtle amendments:-


Sub FindInpatients()

Dim lr As Long
Dim ws As Worksheet

Application.ScreenUpdating = False

For Each ws In Worksheets
    If ws.Name <> "Patient Census" Then
With ws.Range("G1", ws.Range("G" & ws.Rows.Count).End(xlUp))
        .AutoFilter 1, ""
        On Error Resume Next
        .Offset(1).EntireRow.Copy
        Sheet1.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
        Sheet1.Columns.AutoFit
        End With
ws.AutoFilterMode = False
        End If
Next ws

Sheet1.Range("A5:I" & Rows.Count).RemoveDuplicates Columns:=3, Header:=xlYes
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Sub TransferPrevious()

Dim lr As Long
Dim c As Range

Application.ScreenUpdating = False

If ActiveSheet.Previous Is Nothing Then Exit Sub

ActiveSheet.Previous.Select
lr = Range("A" & Rows.Count).End(xlUp).Row

For Each c In Range("G2:G" & lr)
  If c.Value = "" Then
    c.EntireRow.Copy
      ActiveSheet.Next.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
       ActiveSheet.Next.Columns.AutoFit
      End If
Next c

Application.CutCopyMode = False
Application.ScreenUpdating = True
ActiveSheet.Next.Select

End Sub

If you are still having issues with the proper working of the sample work book, please answer the questions in my post #14.

Cheerio,
vcoolio.

Search/Transfer Patient Data

11 responses

Similar discussions

Subscribe To Our Newsletter!