Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngLookup As Range
Dim rngOutput As Range
Dim sUserName As String
Dim lRowNum As Long
'Only run the code if the name is being changed
If Target.Address = "$B$3" Then
'Disable Events to prevent repeat calls to
'the _Change event
Application.EnableEvents = False
'Set range references
Set rngOutput = ActiveSheet.Range("B6")
With Worksheets(2)
Set rngLookup = .Range(.Cells(2, 1), .Cells(2, 2).End(xlDown))
End With
'Clear the Current Output
With rngOutput
'Special Hnadler for cases where only
'one ID is currently used
'(The .End Method won't work in this case)
If .Offset(1, 0).Value = "" Then
.Value = ""
Else
'All other cases - clear the output range
'and all cells immediately under it
.Resize(.End(xlDown).Row - .Row + 1, 1).Value = ""
End If
End With
'Get the name of the user that has been selected
sUserName = Target.Value
With rngLookup
'Loop through the Lookup range
For lRowNum = 1 To .Rows.Count
'Looking for matching User Names
'In the first column
If .Cells(lRowNum, 1).Value = sUserName Then
'Where a match is found - write the
'ID to the output range and move down a row
rngOutput.Value = .Cells(lRowNum, 2)
Set rngOutput = rngOutput.Offset(1, 0)
End If
Next lRowNum
End With
'Re-enable events
Application.EnableEvents = True
End If
'Clear Object Variables
Set rngLookup = Nothing
Set rngOutput = Nothing
End Sub