Replace the lines after your On Error stmt with:

Set ws = Worksheets("Contact List")
LastCell = ws.Cells(Rows.Count, "B").End(xlUp).Row
Set rng = ws.Range("B2:B" & LastCell)
rng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set rng = rng.SpecialCells(xlCellTypeVisible)
With rng
For Each c In rng
ComboBox5.AddItem c
Next
End With
ws.ShowAllData

Hth,
Merjet