Public Sub LookupBranches()
[COLOR=SeaGreen] '''''''''''''''''''constant declarations'''''''''''''''''''''''
' data worksheet name - constant you can change within the code[/COLOR]
Const strData As String = "Data"
[COLOR=SeaGreen] ' interface worksheet name (not used)[/COLOR]
Const strInterface As String = "User Interface"
[COLOR=SeaGreen] ' increment amount for array resizing[/COLOR]
Const iIncrement As Long = 50
[COLOR=SeaGreen] '''''''''''''''''''variable declarations'''''''''''''''''''''''
' string variable to store of the first find in the A column[/COLOR]
Dim strFirstAddress As String
[COLOR=SeaGreen] ' variant to be used as an array to store store locations[/COLOR]
Dim vCustList As Variant
[COLOR=SeaGreen] ' position and current size of the array above[/COLOR]
Dim iPos As Long, iSize As Long
[COLOR=SeaGreen] ' range for which branch list is being created[/COLOR]
Dim rngTarget As Excel.Range
[COLOR=SeaGreen] ' range to look through for customer IDs[/COLOR]
Dim rngCust As Excel.Range
[COLOR=SeaGreen] ' range to store each cell in which the customer ID is found[/COLOR]
Dim rngFind As Excel.Range
[COLOR=SeaGreen] ' used to loop through rngTarget[/COLOR]
Dim rng As Excel.Range
[COLOR=SeaGreen] ' data worksheet[/COLOR]
Dim wshData As Excel.Worksheet
[COLOR=SeaGreen] ' interface worksheet (not used)[/COLOR]
Dim wshInterface As Excel.Worksheet
[COLOR=SeaGreen] '''''''''''''''''''execution section''''''''''''''''''''''''''
' bind data worksheet[/COLOR]
[COLOR=SeaGreen][COLOR=Black] Set wshData = ThisWorkbook.Worksheets(strData)[/COLOR]
' bind interface worksheet[/COLOR]
Set wshInterface = ThisWorkbook.Worksheets(strInterface)
[COLOR=SeaGreen] ' bind list of customer IDs[/COLOR]
Set rngCust = Intersect(wshData.UsedRange, wshData.Range("A:A"))
[COLOR=SeaGreen] ' bind range for which branch list needs to be generated to current selection[/COLOR]
Set rngTarget = Selection
[COLOR=SeaGreen] ' loop through all cells in current selection[/COLOR]
For Each rng In rngTarget.Cells
[COLOR=SeaGreen] ' size array initially[/COLOR]
iPos = 1
iSize = iIncrement
ReDim vCustList(1 To iSize)
[COLOR=SeaGreen] ' find the first customer[/COLOR]
Set rngFind = rngCust.Find(rng.Value)
[COLOR=SeaGreen] ' if customer not found, stop
' you may want to change this to go on to the next customer ID in selection[/COLOR]
If rngFind Is Nothing Then Exit Sub
[COLOR=SeaGreen] ' store the first address[/COLOR]
strFirstAddress = rngFind.Address
[COLOR=SeaGreen] ' keep looking for customer ID until we've found all branches[/COLOR]
Do
[COLOR=SeaGreen] ' store the branch that is found[/COLOR]
vCustList(iPos) = rngFind.Offset(0, 1).Value
[COLOR=SeaGreen] ' move to next position[/COLOR]
iPos = iPos + 1
[COLOR=SeaGreen] ' resize array if necessary[/COLOR]
If iPos > iSize Then
iSize = iSize + iIncrement
ReDim Preserve vCustList(1 To iSize)
End If
[COLOR=SeaGreen] ' find this customer ID again, looking after previous find[/COLOR]
Set rngFind = rngCust.FindNext(rngFind)
[COLOR=SeaGreen] ' keep doing this until Find returns the first branch we found[/COLOR]
Loop Until strFirstAddress = rngFind.Address
[COLOR=SeaGreen] ' downsize array if necessary[/COLOR]
If iPos < iSize Then
iSize = iPos
ReDim Preserve vCustList(1 To iSize)
End If
[COLOR=SeaGreen] ' transfer branch list from array to spreadsheet
' put it immediately to the right of the current customer ID we're looking for[/COLOR]
rng.Offset(0, 1).Resize(1, UBound(vCustList)).Value = vCustList
Next rng
[COLOR=SeaGreen] ' and done![/COLOR]
End Sub