Moving entire rows based on one cells content

[X82]

I am hoping for some magic here and I know I might be asking for a lot.


Some kind soul (and my apologies for not remembering who) made a script for me.


To explain its function, I need to explain the data we get at work here.


One huge spreadsheet, with about 7 columns of addresses.
In column only lists the persons County they are in.


The script that was made takes the entire row which has the county X and put it in a certain tab which X goes into.
It gets this info from a list on the first tab.

X	A
Y	B
Z	B

<tbody>
</tbody>

So any row which column 1 contains X it will copy the entire row to the A tab.
Anything with Y in column 1 gets copied to B and so forth.


Here is the code for that:

Option Explicit




Sub xCode2()


    Dim shSource As Worksheet
    Dim shDest As Worksheet


    Dim strDestSheet As String
    Dim lRowSource As Long
    Dim lColSource As Long
    Dim lRowDest As Long
    Dim lColTable As Long
    Dim i As Long, j As Long


    ' Define the sheet where all rows to be distributed are located.
    Set shSource = ThisWorkbook.Sheets("Data")


    With shSource


        lRowSource = shSource.Cells(.Rows.Count, 1).End(xlUp).Row


        For i = lRowSource To 2 Step -1


            'Debug.Assert .Cells(i, 1).Value <> "NORTH YORKS"


            strDestSheet = vbNullString


            On Error Resume Next
            ' Look in Sheet with table value the string name group for the Country.
            strDestSheet = WorksheetFunction.VLookup(.Cells(i, 1).Value, Worksheets("Locations").Range("A1:B138"), 2, False)
            On Error GoTo 0




            If Not strDestSheet = vbNullString Then


                lColSource = .Cells(i, Columns.Count).End(xlToLeft).Column
                Set shDest = ThisWorkbook.Sheets(strDestSheet)
                lRowDest = shDest.Cells(shDest.Rows.Count, 1).End(xlUp).Row


                ' Copy row from Source sheet to destination.
                shDest.Cells(lRowDest + 1, 1).Resize(, lColSource).Value = shSource.Cells(i, 1).Resize(, lColSource).Value


            Else


                .Cells(i, 1).EntireRow.Interior.ColorIndex = 3
            End If




            'shSource.Cells(i, 1).EntireRow.Delete
        Next i


    End With
End Sub

I will be honest, I am not smart enough with code yet to tell you exactly what it does, but it does seem to work.


I am posting because I am hoping for a more refined version of this as new data sheets which we get can have a different layout.


End Game:


I want it to move the data, not copy. It does highlight red for a row which it cannot find (although recent test runs have highlighted a row in red and I couldn't work out why, it failed to copy that row and I had to do it manually).
This would only leave entries behind which didn't match to the list in the first tab.


Another issue I have run into is that with another sheet we get, the address is not split, but rather one long line with commas seperated street, town, county etc. Text to columns doesn't work too good since a lot of the addresses wont have a town so it all doesn't line up in a column.
So

1 Fake Street	Birmingham	BU11 111
2 Fake Street	Birmingham	West Midlands county	BU11 111

<tbody>
</tbody>

It does not split well.


Another column would be made so running a script to scan one column wouldn't work.


I am sorry to not explaining this in any way clear but I hope that it makes some sense to someone.