Determine Last Used Row

i need to have this information entered in the row below each time which may or maynot be empty. i need a message box with error handling to ask if the user wants to enter more products or finish and another message box if the entries (which start at cell B4) go past B10 that they have to exit and start a new sheet. I have put the code below and attached the workbook so it may be of use to others

Option Explicit

Sub Locate(Name As String, Data As Range)
Dim rngFind As Range
Dim strFirstFind As String
With Data
Set rngFind = .Find(Name, LookIn:=xlValues, lookat:=xlPart)
If Not rngFind Is Nothing Then
strFirstFind = rngFind.Address
Do
If rngFind.Row > 1 Then
ListBox1.AddItem rngFind.Value
End If....................