Identify number from a separate list and copy to separate sheet

[Sharpe2026]

I am trying to work out a way of identifying individuals in a random list as opposed to non-individuals, where each individual does have a known identifier in a separate list. And then cutting out the entire row where the individual is identified to paste into a separate sheet.

For example in the list below:

[TABLE="width: 452"]
<colgroup><col span="3"><col></colgroup><tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]26789[/TD]
[TD]20[/TD]
[TD]MR SMITH J BR 45327[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]26789[/TD]
[TD]20[/TD]
[TD]ALAN TEST TEST ALAN 55859[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]26789[/TD]
[TD]40[/TD]
[TD]COMPANY FNG27CI3214687564[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]26789[/TD]
[TD]75[/TD]
[TD]COMPANY QTG75CI39843575[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]26789[/TD]
[TD]40[/TD]
[TD]J JONES 0000062316 [/TD]
[/TR]
</tbody>[/TABLE]

Rows 1, 2 and 5 are individuals, While rows 3 and 4 are companies.

In a separate works sheet I have a list of individuals and their unique identifiers:

[TABLE="width: 192"]
<colgroup><col width="64" span="3" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl65, width: 64"][/TD]
[TD="class: xl65, width: 64"]A [/TD]
[TD="class: xl65, width: 64"]B[/TD]
[/TR]
[TR]
[TD="class: xl65"]1[/TD]
[TD="class: xl65"]J SMITH[/TD]
[TD="class: xl65"]45327[/TD]
[/TR]
[TR]
[TD="class: xl65"]2[/TD]
[TD="class: xl65"]A TEST[/TD]
[TD="class: xl65"]55859[/TD]
[/TR]
[TR]
[TD="class: xl65"]3[/TD]
[TD="class: xl65"]J JONES[/TD]
[TD="class: xl65"]62316[/TD]
[/TR]
[TR]
[TD="class: xl65"]4[/TD]
[TD="class: xl65"]P HILL[/TD]
[TD="class: xl65"]64677[/TD]
[/TR]
</tbody>[/TABLE]

So i'd like to be able to search the first list for any number contained within the second list and, where it identifies it, cut the row and paste into a third worksheet.


Thank You in Advance

Si

 

[mumps]

Try this macro. Change the sheet names (in red) to suit your needs.

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long, num As Range, desWS As Worksheet, srcWS As Worksheet, numWS As Worksheet, fnd As Range
    Set srcWS = Sheets("[COLOR="#FF0000"]Sheet1[/COLOR]")
    Set numWS = Sheets("[COLOR="#FF0000"]Sheet2[/COLOR]")
    Set desWS = Sheets("[COLOR="#FF0000"]Sheet3[/COLOR]")
    LastRow = numWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each num In numWS.Range("B1:B" & LastRow)
        Set fnd = srcWS.Range("C:C").Find(num, LookIn:=xlValues, lookat:=xlPart)
        If Not fnd Is Nothing Then
            fnd.EntireRow.Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
            fnd.EntireRow.Delete
        End If
    Next num
    Application.ScreenUpdating = True
End Sub

 

[Sharpe2026]

Brilliant, that works perfectly!

Thank you

 

[mumps]

You are very welcome.