Macro to Create a Complete List

Courtney Ruggles

New Member
Joined
Jun 6, 2008
Messages
5
I have a list of customers in column A and the branches that they are associated with in Column B, which in most cases, is more than one. I'd like to write a Macro that, once a customer number is selected in one cell, the macro will populate a complete list of all of the branches related to that customer. Is this possible? I posted this question on egghead as well but was told by a coworker, that this forum far is more helpful.

Thank you in advance for your help!! ~ CR
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Is the customer number in column A?

You want this list populated on a different sheet than where you customer list is?
 
Upvote 0
Yes, the customer number is in column A on a "Data" worksheet. I would like the list to populate on the "User Interface" worksheet.

Thank you again for your help!
 
Upvote 0
Okay, so here's what I did. First some sample data - I used a single sheet, but you can use the macro anywhere, and incorporate it into a workbook change event (or worksheet change) if needed.

To run the macro, I selected the list of customers in column D and hit run. The cells to the right were populated automatically.

Excel Workbook
ABCDEFGHIJ
1Cust 2XCUNM
2Cust 3IJEBH
3Cust 4LVYFA
4Cust 5HXKLF
5Cust 1JSXNXCust 1JSXNXWYQKMOKJTLJUWDXFFRZAHGEFZ
6Cust 2EBQWGCust 2EBQWGRZULMYTKBCFOXZZXJMTUXCUNM
7Cust 3RXKWSCust 3IJEBHRXKWSCDPKJZBLYAGATLPVYFQY
8Cust 4ZFVNKCust 4LVYFAZFVNKEZAKOSGRNAAGCWDCUJFH
9Cust 5NVJBACust 5HXKLFNVJBAFABQVDYMGVWMFIZUSWQR
10Cust 1WYQKM
11Cust 2RZULM
12Cust 3CDPKJ
13Cust 4EZAKO
14Cust 5FABQV
15Cust 1OKJTL
16Cust 2YTKBC
17Cust 3ZBLYA
18Cust 4SGRNA
19Cust 5DYMGV
20Cust 1JUWDX
21Cust 2FOXZZ
22Cust 3GATLP
23Cust 4AGCWD
24Cust 5WMFIZ
25Cust 1FFRZA
26Cust 2XJMTU
27Cust 3VYFQY
28Cust 4CUJFH
29Cust 5USWQR
30Cust 1HGEFZ
Data



This is the code that did it. In another thread earlier this morning, I said that I will document all the code I post from now on; however, I'm in a hurry (Friday night and all) and so let's just say that I lied :LOL: Post back if you need additional guidance.


Code:
Public Sub LookupBranches()
  Const strData As String = "Data"
  
  Const strInterface As String = "User Interface"
  Const iIncrement As Long = 50
  
  Dim strFirstAddress As String
  
  Dim vCustList As Variant
  Dim iPos As Long, iSize As Long
  
  Dim rngTarget As Excel.Range
  Dim rngCust As Excel.Range
  Dim rngFind As Excel.Range
  Dim rng As Excel.Range
  
  Dim wshData As Excel.Worksheet
  Dim wshInterface As Excel.Worksheet
  
  Set wshData = ThisWorkbook.Worksheets(strData)
  Set wshInterface = ThisWorkbook.Worksheets(strInterface)
  
  Set rngCust = Intersect(wshData.UsedRange, wshData.Range("A:A"))
  Set rngTarget = Selection
  
  For Each rng In rngTarget.Cells
    iPos = 1
    iSize = iIncrement
    ReDim vCustList(1 To iSize)
    
    Set rngFind = rngCust.Find(rng.Value)
    If rngFind Is Nothing Then Exit Sub
    
    strFirstAddress = rngFind.Address
    
    Do
      vCustList(iPos) = rngFind.Offset(0, 1).Value
      iPos = iPos + 1
      If iPos > iSize Then
        iSize = iSize + iIncrement
        ReDim Preserve vCustList(1 To iSize)
      End If
      Set rngFind = rngCust.FindNext(rngFind)
    Loop Until strFirstAddress = rngFind.Address
    
    If iPos < iSize Then
      iSize = iPos
      ReDim Preserve vCustList(1 To iSize)
    End If
    
    rng.Offset(0, 1).Resize(1, UBound(vCustList)).Value = vCustList
  Next rng
End Sub
 
Upvote 0
Thank you SO much for providing the code. However, I am having a hard time decyphering it as I am not an advanced VB user :oops:. At your convenience, would it be possible for you to document the code you provided so that I can better understand it? I would really appreciate it!

Thank you in advance for your time and help!

~ CR
 
Upvote 0
Well, did it work?

Code:
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
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,185
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top