Multiple corresponding values (looping)

[investor9987]

I'm using Excel 2003:

I have agents that want to "own" records depending on the zip code. I want to dynamically assign agent to a record based on the zip code. If there was only one agent per zip code, this could easily be done with Lookup. However, in many instances there will be multiple agents for a zip code. In these cases, I was hoping to assign the agents to each record in a round robin fashion.

My agent/zip table would may look something like this:

37011 Smith
37013 Jones
37023 Herrman
37025 Martin
37025 Slater
37025 ORiley
37028 Phelps
37028 Trenton
37029 Reagan

I would then have another sheet made up of home addresses that each have a zip-code. If the record contains zip 37013, I can easily assign that one to Jones. However, if the zip in the record is 37025, there are three agents sharing that zip. So for the first record with 37025, I would assign Martin. The next occurence of 37025 would be Slater and the third would be ORiley. The fourth occurence would go back to Martin and so on.

I have found some versions of what I want to do on this site and others but can't find the looping capability. Is it possible?

 

[jindon]

What I mean is that if 37023 appears 3 in one sheet, but appears 4 in other sheet.
What should have been done with the 5th record?

 

[investor9987]

I was thinking I could use a formula in a cell - have never used code like you describe before. Will this run when there are thousands of records in a sheet? Will be slow as compared to an array formula?

 

[investor9987]

Jindon - I am trying like heck to understand your question, but I can't. Thank you for trying to help, but I'm not sure I can clarify any further.

 

[jindon]

I was thinking I could use a formula in a cell - have never used code like you describe before. Will this run when there are thousands of records in a sheet? Will be slow as compared to an array formula?

Could be done with the formula, but I don't know how...
You should wait for a formula gurus, if you don't want to do it via vba.

 

[investor9987]

OK - I tried the VBA. found a missing quote in datasheet.range ("C") in the second one you gave me. Added the quote and it let me compile it. Not sure what to do now. Tried running the macro assignagents but nothing happened. Never used VBA before.

 

[jindon]

Ok
Let's call:
Sheet1 for List of Zip with Agent
Sheet2 for List of Address with Zip
1) hit Alt + F11 to open VB Editor
2) go to [Insert] - [Module] then paste the code onto the right pane
3) hit Alf + F11 to get back to Excel
4) hit Alt + F8 and select "test" then hit [Run]
Hope this works

Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim a(), i As Long, x
Set ws1 = Sheets("Sheet1") '<- alter to actual sheet name
Set ws2 = Sheets("Sheet2") '<- alter to actual sheet name
a = ws1.Range("a1").CurrentRegion.Resize(,2).Value
With CreateObject("Scripting.Dictionary")
     For i = 1 To UBound(a,1)
          If Not .exists(a(i,1)) Then
               .add a(i,1), a(i,2)
          Else
               .item(a(i,1)) = Split(a(i,2) & ";;" & .item(a(i,1)),";;")
          End If
     Next
     a = ws2.Range("a1").CurrentRegion.Resize(,2).Value
     ReDim Preserve a(1 To UBound(a,1), 1 To 3)
     For i = 2 To UBound(a,1)
          If .exists(a(i,2)) And .item(a(i,2)) <> "N/A" Then
               x = .item(a(i,2))
               a(i,3) = x(UBound(x))
               If UBound(x) > 0 Then
                    ReDim Preserve x(UBound(x) - 1)
               Else
                    x = "N/A"
               End If
               .item(a(i,2)) = x
          End If
     Next
End With
ws2.Range("a1").CurrentRegion.Resize(,3).Value = a
End Sub

Note: code has been edited at 12:50

 

[investor9987]

Ok
Let's call:
Sheet1 for List of Zip with Agent
Sheet2 for List of Address with Zip
1) hit Alt + F11 to open VB Editor
2) go to [Insert] - [Module] then paste the code onto the right pane
3) hit Alf + F11 to get back to Excel
4) hit Alt + F8 and select "test" then hit [Run]
Hope this works

I get a Run time error 13 Type mismatch.

in Sheet 1 I have zipcodes in col A and agents in col b
in Sheet 2 I have Address in Col A, Zip in Cold B and I am hoping your program will assign agents in Col C.

When I debug, it goes into the loop i=1 to Ubound, cycles through that about 3-4 times then errors out with the 13

 

[jindon]

Hummm

Both data include A1?

Can you tell me exact range of both sheet?
e.g A1:B100

 

[investor9987]

Sheet1 is my zipcode/agent table and the range is A1 to B7 (no col headings). The zips are in col A and the agents in Col B.

Sheet2 is A1 to B15. Col A is my address, Col B is my zip, and I am planning putting the agent in Col C.

 

[jindon]

How about?

Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim a(), i As Long, x
Set ws1 = Sheets("Sheet1") '<- alter to actual sheet name
Set ws2 = Sheets("Sheet2") '<- alter to actual sheet name
a = ws1.Range("a1").CurrentRegion.Resize(,2).Value
With CreateObject("Scripting.Dictionary")
     For i = 1 To UBound(a,1)
          If Not .exists(a(i,1)) Then
               .add a(i,1), a(i,2)
          Else
               .item(a(i,1)) = a(i,2) & ";;" & .item(a(i,1))
          End If
     Next
     a = ws2.Range("a1").CurrentRegion.Resize(,2).Value
     ReDim Preserve a(1 To UBound(a,1), 1 To 3)
     For i = 2 To UBound(a,1)
          If .exists(a(i,2)) Then
               If .item(a(i,2)) <> "" Then
                    If InStr(.Item(a(i,2)), ";;")>0 Then
                         x = .item(a(i,2))
                         a(i,3) = Mid$(x, InStrRev(x,";;") + 2)
                         .item(a(i,2)) = Left$(x, InStrRev(x, ";;") -1)
                    Else
                         a(i,3) = .item(a(i,2) : .item(a(i,2)) = ""
                    End If
               End If
          End If
     Next
End With
ws2.Range("a1").CurrentRegion.Resize(,3).Value = a
End Sub