Have a list of patients with admit date and length of stay. Want to make a pivot table where date ca be selected and users can see who was admitted o

[DrFistington]

So here's my issue. I have a list of patients that have been admitted to a certain hospital unit over the last 6 months, and I have their admit date, as well as their total length of stay in hours. What I'd like to be able to do is create a pivot table where users can select a certain date to filter on, and then they will see a list of all the patients whose admission range would have included that date.

Does anyone have any ideas on the easiest way to accomplish this?

 

[cerfani]

Make a cell for the date input have data validation that only allows for date values between the time frame you want them to be able to check. Then make a worksheet change event that triggers from the date input cell that generates a table with results. You can just loop down the source data and add each row that qualifies to the new table. I would just create a new sheet with the table to list the rows that qualified.

 

[cerfani]

I got bored and made this... I made a worksheet with some sample data and the input cell A1 that is validated for dates only. The list of patients is in Columns C:E

Running this code as a worksheet change event will create a new sheet with the list of patients that were in the hospital that date...

Private Sub Worksheet_Change(ByVal Target As Range)
    'Validate if the date input cell was changed
    If Intersect(Target, Range("A1")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

    'Declare sheet references
    Dim resultSheet As Worksheet, thisSheet As Worksheet

    'Check for a previously created results sheet and delete it
    On Error Resume Next
    Set resultSheet = Worksheets("Results")
    If Not resultSheet Is Nothing Then
        Application.DisplayAlerts = False
        resultSheet.Delete
    End If
    On Error GoTo 0

    'set sheet references
    Set thisSheet = ActiveSheet
    Set resultSheet = Worksheets.Add(After:=thisSheet)
    resultSheet.Name = "Results"
    
    'copy table header
    thisSheet.Range("C1:E1").Copy resultSheet.Range("A1")

    'Declare row number references
    Dim sourceRow As Long, endSourceRow As Long, resultRow As Long

    'Determine end of source table
    resultRow = 2
    endSourceRow = thisSheet.Cells(thisSheet.Rows.Count, 3).End(xlUp).Row

    'Declare date references
    Dim admitted As Date, endDate As Date
    Dim hours As Double

    'loop through list of patients and copy to new table on result sheet
    For sourceRow = 2 To endSourceRow
        admitted = thisSheet.Cells(sourceRow, 4)
        hours = thisSheet.Cells(sourceRow, 5)
        endDate = DateAdd("h", hours, admitted)
        If Target >= admitted And Target <= endDate Then
            thisSheet.Range(thisSheet.Cells(sourceRow, 3), thisSheet.Cells(sourceRow, 5)).Copy resultSheet.Cells(resultRow, 1)
            resultRow = resultRow + 1
        End If
    Next sourceRow
    
    'get rid of the walking ants animation
    Application.CutCopyMode = False
End Sub

 

[DrFistington]

I got bored and made this... I made a worksheet with some sample data and the input cell A1 that is validated for dates only. The list of patients is in Columns C:E

Running this code as a worksheet change event will create a new sheet with the list of patients that were in the hospital that date...

Private Sub Worksheet_Change(ByVal Target As Range)
    'Validate if the date input cell was changed
    If Intersect(Target, Range("A1")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

    'Declare sheet references
    Dim resultSheet As Worksheet, thisSheet As Worksheet

    'Check for a previously created results sheet and delete it
    On Error Resume Next
    Set resultSheet = Worksheets("Results")
    If Not resultSheet Is Nothing Then
        Application.DisplayAlerts = False
        resultSheet.Delete
    End If
    On Error GoTo 0

    'set sheet references
    Set thisSheet = ActiveSheet
    Set resultSheet = Worksheets.Add(After:=thisSheet)
    resultSheet.Name = "Results"
    
    'copy table header
    thisSheet.Range("C1:E1").Copy resultSheet.Range("A1")

    'Declare row number references
    Dim sourceRow As Long, endSourceRow As Long, resultRow As Long

    'Determine end of source table
    resultRow = 2
    endSourceRow = thisSheet.Cells(thisSheet.Rows.Count, 3).End(xlUp).Row

    'Declare date references
    Dim admitted As Date, endDate As Date
    Dim hours As Double

    'loop through list of patients and copy to new table on result sheet
    For sourceRow = 2 To endSourceRow
        admitted = thisSheet.Cells(sourceRow, 4)
        hours = thisSheet.Cells(sourceRow, 5)
        endDate = DateAdd("h", hours, admitted)
        If Target >= admitted And Target <= endDate Then
            thisSheet.Range(thisSheet.Cells(sourceRow, 3), thisSheet.Cells(sourceRow, 5)).Copy resultSheet.Cells(resultRow, 1)
            resultRow = resultRow + 1
        End If
    Next sourceRow
    
    'get rid of the walking ants animation
    Application.CutCopyMode = False
End Sub

Awesome! Thanks for your help! Let me give this a shot.

 

[DrFistington]

So I was able to use this and it worked perfectly, thanks for your help! Naturally, the person requesting the report had another request. In the results spreadsheet, I had 4 columns, pt name, admit date, LOS in hours, and a yes/no box to denote if the patient had an underlying oncology diagnosis. Now they are wondering if the report can look at all the data and return average percentage of oncology related patients and non oncology related patients over the whole time frame. Any thoughts?