Snippet 
With Sheets("DataBase").Range("A:A")
Set Found = .Find( What, where, how)
If Found is Nothing then GoTo NotFound
FirstFoundAddress = Found.Address

Do
Add all info to list

Set Found = .FindNext(Found)
Loop While Not Found Is Nothing And Found.Address <> FirstFoundAddress

End With
Exit Sub

NotFound:
MSgBox" Ooooooopsies!"
End Sub