Looping Named Ranges

Dear Excel folks,

I have been painstakingly trying the name multiple set of ranges and I figure that a proper vba code should be able to speed up the process. Below is a sample cell ranging from A1 to B8

_____ A_____|_____B______
1 | Singapore | Town Road
2 | Singapore | East Coast
3 | Singapore | Changi Road
4 | Australia | Canberra
5 | Australia | Melbourne
6 | Australia | Sydney
7 | Australia | Perth
8 | Australia | Queensland

I wish to create a VBA code that effectively name a set ranges based a the left column.

Basing on the above example, once the macros is triggered, it will name the ranges B1:B3 as Singapore and B4:B8 as Australia

I hope my sample is sufficiently concise and clear!
Looking forward to any directions on this. Thanks.

Thanks
Jensen

Try this:-

Sub MG23May36
Dim Rng As Range, Dn As Range
Dim nRng As Range
Dim K
Set Rng = Range(Range("A1"), Range("A" & rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    If Not .Exists(Dn.value) Then
        Set nRng = Dn(, 2)
        .Add Dn.value, nRng
    Else
        Set .Item(Dn.value) = Union(.Item(Dn.value), Dn(, 2))
    End If
Next
For Each K In .keys
    .Item(K).Name = K
Next K
End With
End Sub

Regards Mick

Works perfect! Thank you Mick!