help - "subscript out of range" - when iterating through a dictionary object

Hi buddies!
I pieced together a script that gets the name/date of birth of a any person and stores it in the corresponding dictionary name/value pairs
just before the script finishes executing, it iterates again and this time it should also display the name/value pairs for the newly added entries, but however, just before it starts message boxing out the new entries, I get a run-time error that blows the script off, saying
"subscript out of range: '4'"

here is the entire script posted for those of you willing to help me out in this one. thanks in advice guys. happy early thanksgiving

Option Explicit
'-----------------------------------------------------------------------------
Dim objDictionary, keys, i, prompt, NewKey, NewItem 'explicit declaration of variables
Set objDictionary = WScript.CreateObject("Scripting.Dictionary") 'instantianting the dictionary object for the objName object variable

'addings keys/items to the dictionary
objDictionary.Add "marvin", "May 25, 1966"
objDictionary.Add "melany", "October 22, 1962"
objDictionary.Add "bryan", "May 4, 1990"
objDictionary.Add "iliana", "October 2, 1993"

keys = objDictionary.keys 'assinging the keys collection to a variable
For i = 0 To objDictionary.Count -1 'minus one because keys collection index starts at 0, prevents a out-of-range Error
 MsgBox "family member: " & keys(i) & " DOB: " & objDictionary.Item(keys(i))'grabs the corresponding item for the key indicated by the i counter variable
Next

prompt = MsgBox("do you want to add another person and their DOB?", vbYesNo + vbQuestion +  vbDefaultButton2, "Add More keys/values")

If prompt = vbNo Then
 MsgBox "GOOD-BYE", vbOKOnly + vbExclamation, "Quiting script"
 WScript.quit
Else
 Do 
 NewKey = LCase(InputBox("please enter a name","New Name", "Maria"))
 If NewKey = "" Then
 Exit Do 
 ElseIf Not objDictionary.Exists(NewKey) Then
 NewItem =InputBox("please enter a DOB for : " & NewKey & VbCrLf & "Use this format: Month Day, Year, ""January 6, 2000""", "DOB", "April 11, 1997")
 objDictionary.Add NewKey, NewItem
 Else
 MsgBox "The name you entered already exists, enter a different name", vbOKOnly + vbCritical, "Invalid Key"
 End If
 Loop While NewKey <> "" Or NewItem <> ""

End If

MsgBox "total number of entries in the dictionary: " & objDictionary.Count
 For i =  0 To objDictionary.Count 
 MsgBox "family member: " & keys(i) & " DOB: " & objDictionary.Item(keys(i))
 Next
 

thanks 59cobalt, now that I looked over my code with your explanation of the problem, it makes much more sense and now I am able to run the script with no subscript out-of -range problems
 
have a happy thanksgiving