Vlookup next value

[All2Cheesy]

Hi all,

I'mn probably going to do a terrible job at explaining this, but I need to write a formula to identify which city is sending freight to what postcode. Currently I have a formula(below) which can do this, however, I run into trouble when there are two different cities sending out to the same postcode. The formula I'm using will only list the first city. Is there anyway to have my formula look up the next value once the first value has already been found? Your help is greatly appreciated.

=IFERROR(VLOOKUP(A1,'Postcodes'!$F$23:$H$1048576,3,FALSE),"")

To P/C From city
6017 Melb
6027 Melb
4110 Melb
2680 Melb
2680 Sydn
6104 Sydn
4151 Sydn
4558 Sydn

 

[L. Howard]

Hi All2Cheesy,

Take a look at this single sheet workbook.

https://www.dropbox.com/s/komy0536xry6w3j/Dependent Drop Down Australia City.xlsm?dl=0


Where you will list all Cities in column B, and their Postal Code in column A.

In column P is a UNIQUE list of all the postal codes.

Drop down in D1 will have the column P codes as choices, (up to 200 and changeable if needed) . Pick one...

The drop down in E1 is selected and it will have all the cities served by the choice in D1. Click down arrow and choose city.

Howard



This is the code (in the sheet module) that helps make the page work.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'/// by: Siddharth Rout

    Dim i As Long, LastRow As Long, n As Long
    Dim MyCol As Collection
    Dim SearchString As String, TempList As String
 
    Application.EnableEvents = False
 
    On Error GoTo Whoa
 
    '~~> Find LastRow in Col A
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
 
    If Not Intersect(Target, Columns(1)) Is Nothing Then
        Set MyCol = New Collection
 
        '~~> Get the data from Col A into a collection
        For i = 1 To LastRow
            If Len(Trim(Range("A" & i).Value)) <> 0 Then
                On Error Resume Next
                MyCol.Add CStr(Range("A" & i).Value), CStr(Range("A" & i).Value)
                On Error GoTo 0
            End If
        Next i
 
        '~~> Create a list for the DV List
        For n = 1 To MyCol.Count
            TempList = TempList & "," & MyCol(n)
        Next
 
        TempList = Mid(TempList, 2)
 
        Range("D1").ClearContents: Range("D1").Validation.Delete
 
        '~~> Create the DV List
        If Len(Trim(TempList)) <> 0 Then
            With Range("D1").Validation
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                 xlBetween, Formula1:=TempList
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        End If
    '~~> Capturing change in cell D1
    ElseIf Not Intersect(Target, Range("D1")) Is Nothing Then
        SearchString = Range("D1").Value
 
        TempList = FindRange(Range("A1:A" & LastRow), SearchString)
 
        Range("E1").ClearContents: Range("E1").Validation.Delete
        [E1].Activate
        If Len(Trim(TempList)) <> 0 Then
            '~~> Create the DV List
            With Range("E1").Validation
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                 xlBetween, Formula1:=TempList
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        End If
    End If
 
LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub
 
'~~> Function required to find the list from Col B
Function FindRange(FirstRange As Range, StrSearch As String) As String
    Dim aCell As Range, bCell As Range, oRange As Range
    Dim ExitLoop As Boolean
    Dim strTemp As String
 
    Set aCell = FirstRange.Find(what:=StrSearch, LookIn:=xlValues, _
    lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
 
    ExitLoop = False
 
    If Not aCell Is Nothing Then
        Set bCell = aCell
        strTemp = strTemp & "," & aCell.Offset(, 1).Value
        Do While ExitLoop = False
            Set aCell = FirstRange.FindNext(After:=aCell)
 
            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                strTemp = strTemp & "," & aCell.Offset(, 1).Value
            Else
                ExitLoop = True
            End If
        Loop
        FindRange = Mid(strTemp, 2)
    End If
End Function