VBA: Filtering a list and storing result as named

I have the following list:

I want to make a VBA code filtering the different names on which store they work in, and storing the result in a named range with the name of the store - and the range being the names from the list working in that store.

For example, the named ranges would be London - containing cells B2 and B7, and so on.

EDIT:

I know this is wrong, but I just cannot solve this. VBA is just not what I want it to be at the moment... I first made a new column of the named ranges, and then proceeded.

Sub NamedRange()

Dim arr() As Variant

arr = Sheet1.Range("D2:D4").Value

    Dim i As Integer
    Dim j As Integer
    Dim Name As String
    Dim k1 As Range, k2 As Range

    Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

    i = 0

    Do While i < 4
    Name = arr(i)
    For j = 1 To Lastrow
    k1 = Match(arr(i), Cells(i, 1).Value, 0)
    k2 = Union(k1, k2)

    Next j

    Range(k2).Select
    Application.Goto Reference:=arr(i)

    Loop


End Sub

EDIT2: Spent two hours trying to understand the AdvancedFilter function. Made it work using x1FilterCopy option, but my whole Excel-sheet will be a mess this way. Is there any way of filtering and just storing the filtered range in a variable. God, VBA, why are you made this way?

Try this.

Note that, as said above, using named ranges this way is probably not the best approach.

It may be better to explain your end goal (because you can filter the data and manipulate it from there).

That being said, this does what you are looking for.

For Each cell in B2:B10, we are going to see if a named range exists for that value.

If a named range does not exist, we create one.

If one does exist, we union the two ranges.

Then, we can click on our departments and select the ranges by grabbing their value.

Copy and paste this macro and run NameTheRanges

You can then add event code to sheet one to select ranges when you click on the department.

Sub NameTheRanges()

ClearAllNamedRanges 
Dim c As Range
For Each c In Range("B2:B10")
    If Not DoesNamedRangeExist(c.Value) Then
        c.Offset(0, -1).Name = c.Value
    Else
        Union(Range(c.Value), c.Offset(0, -1)).Name = c.Value
    End If
Next c

End Sub

Function DoesNamedRangeExist(NR As String) As Boolean
Dim checker As Range
On Error Resume Next
Set checker = Range(NR)
On Error GoTo 0
If checker Is Nothing Then
    DoesNamedRangeExist = False
Else
    DoesNamedRangeExist = True
End If
End Function

Sub ClearAllNamedRanges()
Dim NR
For Each NR In ActiveWorkbook.Names
    NR.Delete
Next
End Sub

Event code to select ranges (This goes in the sheet you are using - Sheet1 in my case):

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("E2:E4")) Is Nothing Then Range(Target.Value).Select

End Sub

Results When I click Liverpool (In Cell E3).