[VBA] Cut down a string to match another string, if applicable

[RockandGrohl]

Hi all,

It was all going so well.

In N12 I have a long string of place names, like this:

Aberystwyth, Accrington, Alfreton, Altrincham, Banbury, Bangor, Barnsley, Barrow-in-Furness, Basingstoke, Bath, Bebington, Bedford, Belper, Beverley, Biggleswade, Birkenhead, Bishop Auckland, Blackburn, Blackpool, Bletchley, Bognor Regis, Bolton, Boston, Bournemouth, Bradford, Bridgend, Bridgnorth, Bridgwater, Bridlington, Bridport, Bristol, Bristol Cribbs Causeway, Bromsgrove, Burnley, Burton-upon-Trent, Bury, Bury St Edmunds, Cambridge, Cannock, Cardiff West Services (M4), Carlisle, Carnforth, Chatteris, Cheltenham, Chester, Chesterfield, Chichester, Chippenham, Chorley, Christchurch, Cinderford, Cirencester, Cleethorpes, Cleveleys, Coalville, Coleford, Colne, Colwyn Bay, Corby, Coventry, Crewe, Dalton-in-Furness, Darlington, Darwen, Daventry, Derby, Dewsbury, Doncaster, Dorchester, Driffield, Dudley, Dunstable, Durham, East Cowes, Eastleigh, Ellesmere Port, Ely, Evesham, Exeter Services (M5), Fareham, Fleetwood, Flint, Gainsborough, Gloucester, Gorleston, Grange-over-Sands, Grantham, Grantham North Services (A1), Great Yarmouth, Grimsby, Halesowen, Halifax, Harrogate, Hartlepool, Havant, Hereford, Hessle, Holbeach, Hucknall, Huddersfield, Hull, Hunstanton, Huntingdon, Ilkeston, Ivybridge, Keighley, Kempston, Kendal, Kettering, Keynsham, Kidderminster, Kidsgrove, King's Lynn, Kingswood, Lancaster, Leamington Spa, Leeds, Leeming Bar Services (A1(M)), Leicester, Leigh, Leominster, Letchworth, Leyland, Lincoln, Littlehampton, Liverpool, Llandudno Junction, Llanelli, Long Eaton, Loughborough, Louth, Lowestoft, Ludlow, Luton, Lydney, Lytham St Annes, Mablethorpe, Malton, Mansfield, March, Market Harborough, Melton Mowbray, Middlesbrough, Middlewich, Milton Keynes, Mold, Morley, Newark, Newcastle-under-Lyme, Newcastle-upon-Tyne, Newmarket, Newport (Isle of Wight), Newport (South Wales), Newton Abbot, North Hykeham, Northallerton, Northampton, Northop, Northwich, Norwich, Nottingham, Oswestry, Oxford, Paignton, Penrith, Peterborough, Peterborough Services (A1(M)), Peterlee, Plymouth, Pontefract, Poole, Portsmouth, Prestatyn, Preston, Queensferry, Reading, Rhyl, Ross-on-Wye, Rotherham, Rugby, Runcorn, Rushden, Ryde, Sale, Sandown, Scarborough, S****horpe, Selby, Shanklin, Sheffield, Shipley, Shrewsbury, Skegness, Solihull, Southampton, Southampton Port, Southport, Spalding, St Helens, Stafford, Stamford, Stevenage, Stockton-on-Tees, Stoke-on-Trent, Stonehouse, Stourbridge, Stroud, Sunderland, Sutton Coldfield, Swadlincote, Swansea, Swindon, Taunton, Telford, Tewkesbury, Thetford, Tiverton Sampford Peverell Services (M5), Torquay, Ulverston, Wakefield, Wallasey, Walsall, Wareham, Warrington, Warrington Lymm Services (M6), Warwick, Waterlooville, Wellingborough, Wellington (Shrops.), Welshpool, Weston-super-Mare, Wetherby Services (A1(M)), Weymouth, Whitby, Whitchurch (Shrops.), Whitley Bay, Widnes, Wigan, Wisbech, Wolverhampton, Woodall Services (M1), Woolley Edge Services (M1), Worcester, Worksop, Worthing, Wrexham, Yate, York

In B3 I have another string of placenames, but these can be 1-5 places long, in this instance it's

Bromsgrove, Worcester

What I need to do is cut down N12, that huge list of places, to be only the list of places in B3. So N12's final output would look like:

Bromsgrove, Worcester

Let's use another example, with that same massive list of places. But this time, B3 has "Worcester, Pershore" as valid places.

Because the string in N12 has Worcester, but not Pershore, it needs to look like this "Worcester"

So the challenge for me is making sure that where there are >1 valid placenames, they are comma separated, but if there's only one valid placename, it appears solo.

I've tried various things like INSTR but I can't crack it, like deleting everything else between the commas where it doesn't match the valid pickups.

Thanks for your help.

 

[RockandGrohl]

It seems what it's doing in both instances of the code is applying the previous result to the current route.

So before "Redditch, Alcester" was the correct result for this string:

Leek, Stoke-on-Trent, Newcastle-under-Lyme, Stafford, Stafford Services (M6), Cannock, Lichfield, Tamworth, Hinckley, Nuneaton, Coventry, Wolverhampton, Walsall, Birmingham, Solihull, Warwick, Leamington Spa, Dudley, Stourbridge, Halesowen, Redditch, Alcester, Stratford-upon-Avon

Then the string changes to this:

Penzance, Camborne, Redruth, Falmouth, Truro, St Austell, Liskeard, Saltash, Plymouth, Paignton, Torquay, Newton Abbot, Newquay, Bodmin, Launceston, Exeter Services (M5), Honiton, Taunton, Bridgwater, Burnham-on-Sea, Weston-super-Mare, Clevedon, Nailsea, Bideford, Barnstaple, South Molton, Tiverton Sampford Peverell Services (M5), Lyme Regis, Bridport, Weymouth, Dorchester, Yeovil, Street, Glastonbury, Wells, Shepton Mallet, Bristol, Yate, Bristol Cribbs Causeway, Warminster, Frome, Trowbridge, Melksham, Chippenham, Bath, Keynsham, Kingswood, Llanelli, Swansea, Bridgend, Cardiff, Newport (South Wales), Cwmbran, Caldicot, Chepstow, Thornbury, Dursley, Lydney, Coleford, Cinderford, Ross-on-Wye, Newent, Swindon, Cricklade, Cirencester, Stroud, Stonehouse, Quedgeley, Gloucester, Cheltenham, Bishop's Cleeve, Tewkesbury, Evesham, Pershore, Hereford, Ledbury, Malvern, Worcester, Droitwich, Bromsgrove, Redditch, Solihull, Sutton Coldfield, Walsall, Cannock, Leominster, Ludlow, Bewdley, Kidderminster, Stourbridge, Halesowen, Dudley, Birmingham, Wolverhampton, Welshpool, Shrewsbury, Wellington (Shrops.), Telford

<tbody>
</tbody>

And I now get "Redditch, Alcester, Redditch"

Even though as far as I can tell the variables are re-defined.

For x = 1 To tourreq    
    TRef = adstemp.Range("H" & 11 + x).Value
    Range("A2").Activate
        Do Until Cells(ActiveCell.Row, "A").Value = TRef Or Cells(ActiveCell.Row, "A").Value = ""
        ActiveCell.Offset(1, 0).Activate
        Loop
        If Cells(ActiveCell.Row, "A").Value = "" Then
            If MsgBox("Cannot locate tour reference in 'Adverts'! Please investigate and re-run process.", vbOKOnly + vbExclamation, "Missing tour?") = vbOK Then
            End If
        Else
        Call Update.FreeLine_Find
        Cells(ActiveCell.Row, "H").Value = Format(adstemp.Range("J" & 11 + x).Text, "#,##0.00")
        Cells(ActiveCell.Row, "L").Value = wcs
        Cells(ActiveCell.Row, "M").Value = adstemp.Range("A6").Value & " RT"
        Cells(ActiveCell.Row, "N").Value = adstemp.Range("A2").Value
        ' Cut down route pickups to match paper pickups only
        If adstemp.Range("A8").Value = "Coach" Then


[COLOR=#ff0000][B]        adstemp.Range("N" & 11 + x).Value = Cells(ActiveCell.Row, "I").Value[/B][/COLOR]
[COLOR=#ff0000][B]                Dim Sp As Variant[/B][/COLOR]
[COLOR=#ff0000][B]                Dim i As Long[/B][/COLOR]
[COLOR=#ff0000][B]                Dim Res As String[/B][/COLOR]
[COLOR=#ff0000][/COLOR]
[COLOR=#ff0000][B]                Sp = Split(adstemp.Range("B3"), ", ")[/B][/COLOR]
[COLOR=#ff0000][B]                For i = 0 To UBound(Sp)[/B][/COLOR]
[COLOR=#ff0000][B]                   If InStr(1, ", " & adstemp.Range("N" & 11 + x).Value & ",", ", " & Sp(i) & ",", vbTextCompare) > 0 Then[/B][/COLOR]
[COLOR=#ff0000][B]                      Res = Res & Sp(i) & ", "[/B][/COLOR]
[COLOR=#ff0000][B]                   End If[/B][/COLOR]
[COLOR=#ff0000][B]                Next i[/B][/COLOR]
[COLOR=#ff0000][B]                adstemp.Range("N" & 11 + x).Value = Left(Res, Len(Res) - 2)[/B][/COLOR]
[COLOR=#ff0000][B]                adstemp.Activate[/B][/COLOR]
[COLOR=#ff0000][B]                ad.Activate[/B][/COLOR]
[COLOR=#ff0000][B]                Cells(ActiveCell.Row, "O").Value = adstemp.Range("N" & 11 + x).Value

[/B][/COLOR]
            Else
            Cells(ActiveCell.Row, "O").Value = adstemp.Range("B2").Value
        End If
        If adstemp.Range("A8").Value = "Rail" Then
            Cells(ActiveCell.Row, "O").Value = adstemp.Range("B3").Value
        End If
        Cells(ActiveCell.Row, "AA").Value = adstemp.Range("A7").Value

For posterity, adstemp is a temporary sheet where calculations are made and written to the permanent database, ad (which is where the active cell is)

 

[RockandGrohl]

If you're running it in a loop you may need to clear the variable Res like

adstemp.Range("N" & 11 + x).Value = Left(Res, Len(Res) - 2)
Res=""
Cells(ActiveCell.Row, "O").Value = adstemp.Range("N" & 11 + x).Value

Without sounding like a jackass, I was about to write "Do I need to do this?" then got distracted with responding with the full code. Glad to know I'm not completely useless. Trying it now.

 

[RockandGrohl]

Wahey! It works!!

Thanks all

 

[Peter_SSs]

If you have altered my code, what does it look like now?

 

[Fluff]

Wahey! It works!!

Thanks all

You're welcome & thanks for the feedback

 

[RockandGrohl]

If you have altered my code, what does it look like now?

Hi Peter, I actually used Fluffs as it was faster to step through and trouble shoot in the end (even though both are as fast as executing as each other)

But along the same vein, I would probably just add "sShort = "" " at the very end after I place the applicable pickups down.