Something like this will do it.
It may need error handling in some places.


Option Explicit
Private collPatients As Collection

Sub LoadCollection()

Dim i As Long
Dim c As Long
Dim LR As Long
Dim arr
Dim arrData(1 To 3)

Set collPatients = New Collection

If IsEmpty(Cells(1)) Then
Exit Sub
End If

LR = Cells(65536, 1).End(xlUp).Row

arr = Range(Cells(1), Cells(LR, 3))

On Error Resume Next
For i = 1 To LR
For c = 1 To 3
arrData(c) = arr(i, c)
Next c
collPatients.Add arrData, CStr(arr(i, 1))
Next i

End Sub

Sub SaveCollection()

Dim i As Long
Dim c As Long
Dim lCount As Long
Dim arr

If collPatients Is Nothing Then
Exit Sub
End If

If collPatients.Count = 0 Then
Exit Sub
End If

Application.ScreenUpdating = False

Cells.Clear

For i = 1 To collPatients.Count
For c = 1 To 3
Cells(i, c) = collPatients(i)(c)
Next c
Next i

Application.ScreenUpdating = True

End Sub

Function ClearOldScripts() As Long

Dim i As Long

For i = collPatients.Count To 1 Step -1
If Date collPatients(i)(3) Then
collPatients.Remove i
ClearOldScripts = ClearOldScripts + 1
End If
Next i

End Function

Sub Prescribe(lPatientID As Long, _
lDays As Long, _
Optional daStartDate As Date = -1)

Dim arrData(1 To 3)

If collPatients Is Nothing Then
Set collPatients = New Collection
End If

If daStartDate = -1 Then
daStartDate = Date
End If

arrData(1) = lPatientID
arrData(2) = daStartDate
arrData(3) = daStartDate + lDays

On Error Resume Next
collPatients.Add arrData, CStr(lPatientID)

If Err.Number < 0 Then
'remove the old prescription when prescribing to same patient
'this may have to be handled differently
collPatients.Remove CStr(lPatientID)
collPatients.Add arrData, CStr(lPatientID)
End If

End Sub

Function CountPrescribedOnDate(Optional daTestDate As Date = -1) As Long

Dim item

If daTestDate = -1 Then
daTestDate = Date
End If

For Each item In collPatients
If daTestDate = item(2) And daTestDate <= item(3) Then
CountPrescribedOnDate = CountPrescribedOnDate + 1
End If
Next item

End Function

Sub test()

Dim daTestDate As Date

LoadCollection

If Not collPatients Is Nothing Then
MsgBox ClearOldScripts(), , "old scripts cleared"
End If

daTestDate = "16/05/2008"

Prescribe 80, 30, "10/01/2007"
Prescribe 100, 30, "22/04/2008"
Prescribe 101, 30, "22/04/2008"
Prescribe 102, 30, "22/05/2008"
Prescribe 103, 100, "22/06/2008"

MsgBox CountPrescribedOnDate(daTestDate), , _
"patients on drug at " & daTestDate

SaveCollection

End Sub


RBS



"Doctor Frank" wrote in message
...
Hello, I wonder if you might be able to guide me in the right
direction. I am a physician and need a bit of help. One of the
medications I prescribe is limited to prescribing it to only 100
patients at a time. This number is based on the script activity. For
example if I write for 30 days worth of the medication on January
first,,, that counts as 'one patient' for the next 30 days. If I
write for another patient on January 1st for 15 days worth of the
medication,, then he counts as a hit for the next fifteen days. So,
from the 1st to the 15th,, I will have '2' patients,, then after the
15th, I drop to one patient as the one patients script has expired.
Want to have a simple interface where the Doctor taps his name,,
enters a medical identifier for the patient and taps how long the
script is active for. Then the number of active patients appears in a
box. This is so the doctor does not have any more than 100 patients
active at any one time. One should also be able to type in a date in
the future,, say January 19th in this example,, and get the box to
show that on that date you will only have '1' active patient. Any
guidance would be appreciated,, I am doing this to help a patient
group that is in need,, I have no financial interest in selling this,,
just want to do it to help out. Thanks,,



F. Kunkel, MD