Modify neighbouring cell based upon cell content

[Imrhien]

G'day everyone, first time poster Imrhien here.

I've got an address database that I regularly upload to our shipping tool. The shipping tool doesn't correct invalid suburb/town combinations, so I want a macro that will search for suburb cells containing certain suburb names, and modify their neighbouring cell (the town) based upon the item found.
Eg:

 J                K  TOWN        SUBURB Auckland    Green Bay

> Search for "Green Bay"
> Change "Auckland" to "Waitakere"

TOWN SUBURB
Waitakere Green Bay

The suburbs are in column K, the towns are in column J. There will be about 10 town/suburb combinations in total, but I think once I see the basic code I'll be able to make modifications

Thanks in advance to anyone who helps. Macros ROCK!

 

[Imrhien]

gah, it stuffed up my table. Here's those columns again:

TOWN - SUBURB
Auckland - Green Bay

> Search for "Green Bay"
> Change "Auckland" to "Waitakere"

TOWN SUBURB
Waitakere Green Bay

 

[mirabeau]

Can you give a couple more illustrative rows?

Like if you start with
TOWN - SUBURB
Auckland - Green Bay
Auckland - Otara

How do you know you should change one Auckland to Waitakere, and the other one to Manukau?

 

[Imrhien]

I won't be correcting issues for every suburb in the country, just a few typical ones that often get inputted incorrectly.

So my logic is:

If suburb cell contains "Green Bay", change neighbouring town cell to "Waitakere".

I'll write multiple IFs for each suburb/town combination I want altered.

Here's my code thus far with pseudo code inserted in the spots where I don't know the code words:

Do

    If ActiveCell.Value = "Green Bay" Then

        NEIGHBOURING CELL VALUE = "Waitakere"

    End If

    If ActiveCell.Value = "East Tamaki" Then

        NEIGHBOURING CELL VALUE = "Manukau"

    End If


    ActiveCell.Offset(1, 0).Select

    Loop Until IsEmpty(ActiveCell.Offset(0, 1))

 

[Imrhien]

The searching line will need to be case insensitive, as GREEN BAY and green bay are also acceptable terms.

 

[mirabeau]

I don't follow what you want.

If you have a list somewhere associating each suburb with a larger (smaller?) suburb, why not just use this list?

Otherwise do you want a macro to look up Wise's directory or similar to get its associations?

And multiple IFS would generally be a very inefficient approach to what this sort of problem seems to be (straightforward association of two names?)

 

[Imrhien]

Our shipping system won't accept addresses combinations such as "Green Bay, Auckland" - in this case "Green Bay, Waitakere" is the acceptable combination.

I want the Macro to change invalid combinations into correct ones so that we can upload the spreadsheet to our shipping system without any errors.

Below: the current incarnation of my script. I need to make the IFs case insensitive, and hopefully find a more efficient way of checking and changing the values to replace my dirty IFs!

Columns("K:K").Select
Do

    'Waitakere Fixes
    
    If ActiveCell.Value = "Green Bay" Then
    ActiveCell.Offset(0, -1).Value = "Waitakere"
    End If
    
    If ActiveCell.Value = "Glen Eden" Then
    ActiveCell.Offset(0, -1).Value = "Waitakere"
    End If
    
    If ActiveCell.Value = "Kelston" Then
    ActiveCell.Offset(0, -1).Value = "Waitakere"
    End If
    
    If ActiveCell.Value = "New Lynn" Then
    ActiveCell.Offset(0, -1).Value = "Waitakere"
    End If
    
    'Manukau Fixes
    
    If ActiveCell.Value = "East Tamaki" Then
    ActiveCell.Offset(0, -1).Value = "Manukau"
    End If
    
    If ActiveCell.Value = "Albany" Then
    ActiveCell.Offset(0, -1).Value = "North Shore City"
    End If

    ActiveCell.Offset(1, 0).Select

Loop Until IsEmpty(ActiveCell.Offset(1, 0))

It's doing what I want now, just a bit untidy and bloated, and lacking case insensitivity.

 

[Imrhien]

Starting to look good now! I'm sure I can do better than these IFs, perhaps some kind of 2d array? It's been a while since I've programmed anything.

Columns("K:K").Select
Do

    'Waitakere Fixes
    
    If UCase(ActiveCell.Value) = "GREEN BAY" Then
    ActiveCell.Offset(0, -1).Value = "Waitakere"
    End If
    
    If UCase(ActiveCell.Value) = "KELSTON" Then
    ActiveCell.Offset(0, -1).Value = "Waitakere"
    End If
    
    If UCase(ActiveCell.Value) = "NEW LYNN" Then
    ActiveCell.Offset(0, -1).Value = "Waitakere"
    End If
    
    'Manukau Fixes
    
    If UCase(ActiveCell.Value) = "EAST TAMAKI" Then
    ActiveCell.Offset(0, -1).Value = "Manukau"
    End If
    
    If UCase(ActiveCell.Value) = "EAST TAMAKI HEIGHTS" Then
    ActiveCell.Offset(0, -1).Value = "Manukau"
    End If
    
    'North Shore Fixes
    
    If UCase(ActiveCell.Value) = "ALBANY" Then
    ActiveCell.Offset(0, -1).Value = "North Shore City"
    End If

    ActiveCell.Offset(1, 0).Select

Loop Until IsEmpty(ActiveCell.Offset(1, 0))

 

[Imrhien]

Currently:

I need help with:
-specifying the bottom of the column as the end of the loop (as some cells may be empty)
-changing the IF statements for something more compact

My script is working well enough now however, so thanks for looking

 

[mirabeau]

Currently:

I need help with:
-specifying the bottom of the column as the end of the loop (as some cells may be empty)
-changing the IF statements for something more compact

Hey,

Try this then. On a worksheet, put a few suburbs, massey or Massey, Otara or otara etc in Column A.

Run the code and see what it does. If you like it, you should be able to modify/extend it easily enough.

Dim d As Object, waitak, manuk
Dim e, lr&, q
Set d = CreateObject("scripting.dictionary")

waitak = Array("Kelston", "Te Atatu", "Oratia", "Massey")
manuk = Array("Mangere", "Otara", "Tamaki")

For Each e In waitak: d(e) = "Waitakere": Next e
For Each e In manuk: d(e) = "Manukau": Next e

lr = Range("A1")(Rows.Count).End(3).Row
For Each e In Range("A1").Resize(lr)
    q = Application.Proper(e)
    If d(q) <> Empty Then e.Offset(, 1) = d(q)
Next e
End Sub