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

With
Col_A contains doctors (A1 is the heading: MD_Name)
Col_B contains patients (B1 is the heading: Patient_ID)
Col_C contains start dates (C1 is the heading: StartDate)
Col_D contains dosage days (D1 is the heading: NumDays)

Try this:
F1: MD
F2: (doctor name to find)

G1: RefDate
G2: (a date)

H1: On RefDate

This formula returns the number of patients, on the
ref date, for that doctor:
H2: =SUMPRODUCT((A2:A20=F2)*($C2:C20<=G$2)*(($C2:C20+$D2:D20-1)>=G$2))

I1: RefDate+30

This ARRAY FORMULA, committed with CTRL+SHIFT+ENTER,
instead of ENTER, returns the max number of patients for that doctor
during the 31 day period beginning on the RefDate:
I2: =MAX(FREQUENCY(IF((A2:A20=F2)*($C2:C20<=TRANSPOSE(G$2+ROW(INDEX(A:A,1):
INDEX(A:A,30))-1))*(($C2:C20+$D2:D20-1)>=TRANSPOSE(G$2+ROW(INDEX(A:A,1):
INDEX(A:A,30))-1)),TRANSPOSE(G$2+ROW(INDEX(A:A,1):INDEX(A:A,30))-1)),
TRANSPOSE(G$2+ROW(INDEX(A:A,1):INDEX(A:A,30))-1)))

Adjust range references to suit your situation.

Is that something you can work with?
Post back if you have more questions.

----------------------
Regards,

Ron
Microsoft MVP - Excel