# Vlookup next value

#### All2Cheesy

##### Board Regular
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.

Code:
``=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

### Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

#### L. Howard

##### Well-known Member
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.

Code:
``````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``````

Replies
1
Views
178
Replies
1
Views
306
Replies
1
Views
359
Replies
1
Views
214
Replies
2
Views
252

Threads
1,195,596
Messages
6,010,637
Members
441,558
Latest member
lambierules

### 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

### 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