Private Sub Name_Change()

On Error Resume Next
num.Value = Application.VLookup(Name.Value, Worksheets("Help").Range("C3:F5000"), 3, False)

ListBox1.Clear

Dim ws As Worksheet
Dim ilastrow As Long
Dim irow As Long

Set ws = Worksheets("Sheet1")
ilastrow = ws.Range("B6000").End(xlUp).Row

For irow = 3 To ilastrow
    If Trim(ws.Range("B" & irow).Value) = Name.Value Then
        With ListBox1
            .AddItem Trim(ws.Range("E" & irow).Value) & "    -    " & Trim(ws.Range("F" & irow))
        End With
    End If
Next irow


End Sub