Highlighting postcodes on a map

[monkeyharris]

Dear all,

I have a postcode map that shows UK postcodes inside each zone and a corresponding list.
There is a search field where the user enters the postcode and what i want is for the corresponding map square to change colour for easy and quick reference to where it is.
Under this i know how to make a field show which branch is closest to the chosen postcode, i'm just struggling with how to make the image change colour. I couldn't copy the map into a mini sheet so attached an image.

IDS Postcode Map.xlsx
	T	U	V	W	X	Y
56
57	Enter Postcode		RH		Swindon	RG
58	IDS Branch				Swindon	SL
59					Swindon	OX
60					Woodford	CM
61					Woodford	RM
62					Woodford	SG
General Tariff

 

[Snakehips]

@monkeyharris If I'm understanding this correctly then you are wanting to highlight the selected postcode area on a map of UK?

To do this, you will need to have the map as a group of separate images of each postcode area. Each of which will need to be named in a way that relates to the postcode. Do you have this?
You will then need VBA, likely in a Worksheet_Change event, that will determine the appropriate area image and change the colour.

 

[monkeyharris]

@monkeyharris If I'm understanding this correctly then you are wanting to highlight the selected postcode area on a map of UK?

To do this, you will need to have the map as a group of separate images of each postcode area. Each of which will need to be named in a way that relates to the postcode. Do you have this?
You will then need VBA, likely in a Worksheet_Change event, that will determine the appropriate area image and change the colour.

Hi Snakehips,

Each postcode (image) is individual and put together to look like one image. I can save each one as HP, E, SW etc etc for the VBA.

 

[Snakehips]

Ok let me come up with a code to try out.
I will need to know if they are totally independent images or if they are grouped, the name of the group.

 

[monkeyharris]

Ok let me come up with a code to try out.
I will need to know if they are totally independent images or if they are grouped, the name of the group.

I've moved some of the segments to give you an idea of how they each look before i moved them together. See attached.

 

[Snakehips]

So just to be sure. All segments are individual shapes that are not in any way grouped?
Forecolour of shapes is normally white and to be changed to red as and when its code is entered in V57 ?
Red to revert to white when another code is entered?

 

[monkeyharris]

So just to be sure. All segments are individual shapes that are not in any way grouped?
Forecolour of shapes is normally white and to be changed to red as and when its code is entered in V57 ?
Red to revert to white when another code is entered?

You have summed it up perfectly. Thank you so much for helping.

 

[Snakehips]

This appears to work for me on a simple test.
Assumes that shape names equate to area code as entered in V57.
Pate the code into the sheets's code pane within the VBA editor and give it a try on a backed up copy of your workbook.

Sub Worksheet_Change(ByVal Target As Range)
Dim OlsCode As String
Dim NewCode As String

    ' Check if 'Target' is the single cell  entry cell V57
    'If not then exit , do nothing
    If Intersect(Range("V5"), Target) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
 'Otherwise
NewCode = UCase(Target.Text)   'Entered postcode

 Application.ScreenUpdating = False
 Application.EnableEvents = False
    Application.Undo  'to get the previous
    OldCode = UCase(Target.Text)  'previous
    Target = NewCode  'reset target
    
    On Error Resume Next 'ignore errors ifcode not valid shape name
 'Whiten old segment
ActiveSheet.Shapes(OldCode).Fill.ForeColor.RGB = vbWhite
     
'Redden new sgment
If NewCode <> "" Then ActiveSheet.Shapes(NewCode).Fill.ForeColor.RGB = vbRed

On Error GoTo 0  'reset error default
 Application.ScreenUpdating = True
 Application.EnableEvents = True

End Sub

HTH

 

[Snakehips]

Opps! Just noticed that the above code has my test entry cell reference of V5 rather than your desired V57
Just edit that line as below

 If Intersect(Range("V57"), Target) Is Nothing Then Exit Sub

 

[monkeyharris]

Opps! Just noticed that the above code has my test entry cell reference of V5 rather than your desired V57
Just edit that line as below

 If Intersect(Range("V57"), Target) Is Nothing Then Exit Sub

Hi Snakehips,
I've been away for a few days and will be testing this first thing in the morning. Can't wait.