Identify number from a separate list and copy to separate sheet

Sharpe2026

New Member
Joined
Jul 5, 2019
Messages
2
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:

ABC
12678920MR SMITH J BR 45327
22678920ALAN TEST TEST ALAN 55859
32678940COMPANY FNG27CI3214687564
42678975COMPANY QTG75CI39843575
52678940J JONES 0000062316

<colgroup><col span="3"><col></colgroup><tbody>
</tbody>

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:

A B
1J SMITH45327
2A TEST55859
3J JONES62316
4P HILL64677

<colgroup><col width="64" span="3" style="width:48pt"> </colgroup><tbody>
</tbody>

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
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,311
Try this macro. Change the sheet names (in red) to suit your needs.
Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,130,322
Messages
5,641,529
Members
417,215
Latest member
Diaryman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top