Offset Index Match Issue

[Smitty]

OK,

There's gotta be an easier way to do this, but I guess i'm just having a bad day. I have a list of nationwide zip codes corresponding to given markets, when a user selects a particular market, I need to return all of the corresponding zip codes for that market to populate list boxes. I've gotten the following method to work, but it seems crude to me especially from a manual standpoint. Any better ideas would be appreciated.

Book3
	A	B	C	D	E
1	Market	Zips		MarketSelection	CorespondingZips
2	Austin	78613		Chicago	46303
3	Austin	78617			46304
4	Austin	78624			46307
5	Austin	78626			46311
6	Chicago	46303			46312
7	Chicago	46304
8	Chicago	46307
9	Chicago	46311
10	Chicago	46312
11	Cincinnati	41001
12	Cincinnati	41005
13	Cincinnati	41011
14	Cincinnati	41014
15	Cincinnati	41015
16	Cleveland/Akron/Canton	43011
17	Cleveland/Akron/Canton	43015
18	Cleveland/Akron/Canton	43074
19	Cleveland/Akron/Canton	43302
20	Cleveland/Akron/Canton	43314
Sheet1

Thanks!

Smitty

 

[NateO]

Hello Smitty,

Hmmm, what does this mean:

I need to return all of the corresponding zip codes for that market to populate list boxes.

Here's a list:

<pre>Function FindEm(<FONT COLOR="#00007F">ByVal</FONT> n <FONT COLOR="#00007F">As</FONT> Range, <FONT COLOR="#00007F">ByVal</FONT> srchRng <FONT COLOR="#00007F">As</FONT> Range) <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>
<FONT COLOR="#00007F">Dim</FONT> OrigCl <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>, cl <FONT COLOR="#00007F">As</FONT> Range, tmpStr <FONT COLOR="#00007F">As</FONT> <FONT COLOR="#00007F">String</FONT>
<FONT COLOR="#00007F">Set</FONT> cl = srchRng.Find(n.Value)
<FONT COLOR="#00007F">If</FONT> <FONT COLOR="#00007F">Not</FONT> cl <FONT COLOR="#00007F">Is</FONT> <FONT COLOR="#00007F">Nothing</FONT> <FONT COLOR="#00007F">Then</FONT>
tmpStr = cl(, 2)
OrigCl = cl.Address
Do: <FONT COLOR="#00007F">Set</FONT> cl = srchRng.FindNext(cl)
<FONT COLOR="#00007F">If</FONT> cl.Address <> OrigCl <FONT COLOR="#00007F">Then</FONT> _
tmpStr = tmpStr & vbLf & cl(, 2)
<FONT COLOR="#00007F">Loop</FONT> <FONT COLOR="#00007F">Until</FONT> cl.Address = OrigCl
<FONT COLOR="#00007F">Set</FONT> cl = <FONT COLOR="#00007F">Nothing</FONT>
<FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">If</FONT>
FindEm = tmpStr
<FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">Function</FONT>


<FONT COLOR="#00007F">Sub</FONT> test()
MsgBox FindEm([d2], Sheets(1).[a:a])
<FONT COLOR="#00007F">End</FONT> <FONT COLOR="#00007F">Sub</FONT>
</pre>

 

[Smitty]

Hey Nate,

Hmmm, what does this mean:

quote:

I need to return all of the corresponding zip codes for that market to populate list boxes.

Specifically, a user will select a particular market, let's say Austin. I need to pull every zip code that is associated with Austin from my zip code table to populate list boxes. The use can select from that list of Austin's zip codes. This is to limit them from having to search through over 5,000 zip codes.

Thanks for the function. I'll give it a whirl.

Smitty

 

[NateO]

Hello again Smitty,

The following worksheet change procedure will maintain a validated list in e2 for you, might be of interest:

<font face=Courier New><SPAN style="color:darkblue">Private</SPAN> <SPAN style="color:darkblue">Sub</SPAN> Worksheet_Change(<SPAN style="color:darkblue">ByVal</SPAN> Target <SPAN style="color:darkblue">As</SPAN> Range)
<SPAN style="color:darkblue">Dim</SPAN> OrigCl <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">String</SPAN>, cl <SPAN style="color:darkblue">As</SPAN> Range, tmpStr <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">String</SPAN>
<SPAN style="color:darkblue">If</SPAN> Intersect([d2], Target(1, 1)) <SPAN style="color:darkblue">Is</SPAN> <SPAN style="color:darkblue">Nothing</SPAN> <SPAN style="color:darkblue">Then</SPAN> <SPAN style="color:darkblue">Exit</SPAN> <SPAN style="color:darkblue">Sub</SPAN>
<SPAN style="color:darkblue">Set</SPAN> cl = [a:a].Find(Target(1, 1).Value)
<SPAN style="color:darkblue">If</SPAN> <SPAN style="color:darkblue">Not</SPAN> cl <SPAN style="color:darkblue">Is</SPAN> <SPAN style="color:darkblue">Nothing</SPAN> <SPAN style="color:darkblue">Then</SPAN>
    tmpStr = cl(, 2)
    OrigCl = cl.Address
    Do: <SPAN style="color:darkblue">Set</SPAN> cl = [a:a].FindNext(cl)
        <SPAN style="color:darkblue">If</SPAN> cl.Address <> OrigCl Then _
            tmpStr = tmpStr & "," & cl(, 2)
    <SPAN style="color:darkblue">Loop</SPAN> <SPAN style="color:darkblue">Until</SPAN> cl.Address = OrigCl
    <SPAN style="color:darkblue">Set</SPAN> cl = <SPAN style="color:darkblue">Nothing</SPAN>
<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">If</SPAN>
<SPAN style="color:darkblue">With</SPAN> [e2].Validation
    .Delete
    .Add xlValidateList, xlValidAlertStop, , tmpStr
<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">With</SPAN>
<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">Sub</SPAN></FONT>

 

[Smitty]

Cool! Thanks again Nate!

 

[Ekim]

Smitty,

The following ha been adapted from a macro authored by Andrew Poulsom (as amended by Razzandy) at http://www.mrexcel.com/board2/viewtopic.php?t=44801

The macro has been set for Sheet3 (amend to suit). See Notes at end.

Sub Findme()
'adapted from macro by Andrew Poulsom as amended by Razzandy
'http://www.mrexcel.com/board2/viewtopic.php?t=44801

    Dim Na
    Dim Rng As Range
    Dim F As Range
    Dim FirstAddress As String
    Dim R As Long
    Dim ClearRange As Range
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets(3)
    Set ClearRange = ws.Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row)

    With ClearRange
        .ClearContents
    End With

    Na = Worksheets("Sheet3").Range("D2")
    If Na = "" Then Exit Sub
    Set Rng = Range("Table")
    Set F = Rng.Find(What:=Na, After:=Rng.Cells(Rng.Rows.Count, _
         Rng.Columns.Count))
    If Not F Is Nothing Then
        FirstAddress = F.Address

        If Sheets("Sheet3").Range("E2") <> "" Then
            R = Range("Table").Rows.Count + 1
        End If
        If Sheets("Sheet3").Range("E2") = "" Then
            R = 2
        End If
        With Sheets("Sheet3").Cells(R, 4)
            .Offset(0, 1) = F.Offset(0, 1).Value
        End With
        Do
            R = R + 1
            Set F = Range("Table").FindNext(After:=F)
            If F.Address = FirstAddress Then Exit Do
            With Sheets("Sheet3").Cells(R, 4)
                .Offset(0, 1) = F.Offset(0, 1).Value
            End With
        Loop
    Else
        MsgBox ("Not found")
    End If

    Set Rng = Nothing
    Set F = Nothing
    Set ClearRange = Nothing
    Set ws = Nothing

End Sub

Notes:
1. Range “Table” is a dynamic range covering A2:B(whatever).
2. D2 is a Validation drop-down, with a dynamic range covering A2:A(whatever). Get a unique list via Advanced Filter/unique list i.e. no duplicates.

Not sure what pupose is served by populating a listbox - the above macro populates column E2 (downwards).

Regards,


Mike

 

[Ekim]

Smitty,

Just in case you really do want a ListBox.

Put a listbox (Tool Box menu) on your worksheet. Assumed to be ListBox1.

In the relevant sheet module:

Private Sub Worksheet_Change(ByVal Target As Range)

ListBox1.Clear

For Each c In Range("Table").Columns(1).Cells
    If c.Value = Range("D2").Value Then
        ListBox1.AddItem c.Offset(0, 1).Value
    End If
Next

  ListBox1.ListIndex = 0
  
End Sub

Same deal as with the previous macro – range Table is a dynamic range that covers A2:B(whatever). Validation drop down in D2 with a list covering A2:A(whatever). Get a unique list via Advanced Filter/unique list i.e. no duplicates.

Regards,

Mike

 

[Smitty]

Thanks Mike.

I'll play with these and Nate's options today.

Smitty