macro to find and extract specific numbers

[whitoulias]

Hello to all

I have 20 numbers from D3 to W3. Numbers range from 1 to 80. There are several rows with numbers.

I would like a macro to pic from each row specific numbers and copy them to EC3.

Any ideas?

Thank you

 

[mumps]

How do you determine which number you want to pick and also from which row to pick from?

 

[whitoulias]

i have 20 specific numbers in column AA...starting from AA1 till AA2.

All rows must be checked.

 

[mumps]

I assume you meant from AA1 to AA20. However, I'm still a little confused as to what you would like to do. Could you please clarify using one or two examples with their cell references.

 

[whitoulias]

OK (all references are for example, dont be confused with the cells above)

I have several rows with 20 random numbers ranging from 1 to 80.

So in first row i have lets say 1,3,5,7,9,22,24,56,34,78,60,12,18,35,57,79,23,45,12,46 starting from A1 to T1. Notice that numbers dont repeat in each row.

In RANGE("U1:U20") i have chosen 20 numbers of my own (always in range from 1 to 80)

I would like a code to check if any of my numbers in range ("U1:U20") match with any in range ("A1:T1"). This has to be done for all rows.

IF any number match THEN it should be copied in V1. IF there are five matching numbers then they should be copied in range ("V1:Z1")

This has to be performed for all the rows (if in row 20 there are 5 matching numbers they should be copied in range("V20:Z20")

Hope this helps

Thank you for your patience

 

[mumps]

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim bottomU As Integer
    bottomU = Range("U" & Rows.Count).End(xlUp).Row
    Dim cRng As Range
    Dim lCol As Long
    Dim foundVal As Range
    Dim x As Long
    For x = 1 To bottomU
         For Each cRng In Range("U1:U20")
            With Range("A" & x & ":T" & x)
                Set foundVal = .Find(what:=cRng, _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
                If Not foundVal Is Nothing Then
                    cRng.Copy Cells(x, Range("IV" & x).End(xlToLeft).Column).Offset(0, 1)
                End If
            End With
        Next cRng
    Next x
End Sub

 

[whitoulias]

Thank so much for your reply
I will try it and let you
thank you again

 

[whitoulias]

It worked just fine

Mumps thx a lot

 

[mumps]

My pleasure.