Code To Look For Number On Sheet 2, When Found Insert Row & Add Number Next To It

[Dazzawm]

Hi, I have sheet 1 with 3 columns of data. The code needs to look for the number that is in column C on sheet 1 on sheet 2. When it is found I need a row inserted below on sheet 1 with the numbers that are next to that number on sheet 2. The example below will explain better.

Excel Workbook
	A	B	C
10	9	AR145161001	EFAR8008
11	10	AR145161001	ECAR5012
12	11	AR145161001	EXAR9001
Sheet1

Excel Workbook
	A	B	C	D
2	1	EFAR8008	EMG002	Gasket
3	2	ECAR5012	EMG002	Gasket
4	3	ECAR5012	EMG171	Gasket
5	4	EXAR9001	EMR031	Rubber
6	5	EXAR9001	EMR113	Rubber
7	6	EXAR9001	EMR130	Rubber
Sheet2

Excel Workbook
	A	B	C	D
10	9	AR145161001	EFAR8008
11	9	AR145161001	EMG002	Gasket
12	10	AR145161001	ECAR5012
13	10	AR145161001	EMG002	Gasket
14	10	AR145161001	EMG171	Gasket
15	11	AR145161001	EXAR9001
16	11	AR145161001	EMR031	Rubber
17	11	AR145161001	EMR113	Rubber
18	11	AR145161001	EMR130	Rubber
Sheet1 Result

As you can see in the 3rd table is the result on sheet 1. It has found wherever the number is on sheet 2 and add the data that is next to it in columns C & D on sheet 2. Please help and can get big brownie points from my Director!!!

 

[Dazzawm]

What is in red in the third table is whats been inserted below the black when its been found on sheet 2. Help please Mick if your'e about!!

 

[Dazzawm]

Please help someone, really need a solution ASAP please!!!

 

[Dazzawm]

Somebody please help. If I don't get a solution by 4pm I could end up with the sack!!!

 

[bertie]

try this in a standard module:

Option Explicit


Sub test()
   Dim wsSource As Worksheet
   Dim wsTarget As Worksheet
   Dim strFind As String
   Dim rowCopy As Long
   Dim rowPaste As Long
   Dim i As Long
   Dim lr As Long
   Dim strFoundAddress As String
   Dim rngFound As Range
   Dim strId As String
   Dim lngId As Long
   
   Set wsTarget = Sheets("Sheet1")
   Set wsSource = Sheets("Sheet2")
   
   'get the last row
   lr = wsTarget.Range("A" & Rows.Count).End(xlUp).Row
   rowPaste = lr

      For i = 10 To lr
         With wsTarget
            lngId = .Range("A" & i).Value             'eg 1, 2, 3, etc
            strId = .Range("B" & i).Value             'eg AR145....
            strFind = wsTarget.Range("C" & i).Value   'eg EFAR.....
         End With
         
         With wsSource.Range("A2:D10")
            Set rngFound = .Find(strFind, LookIn:=xlValues)
            
            If Not rngFound Is Nothing Then
               strFoundAddress = rngFound.Address
               
               Do
                  rowCopy = rngFound.Row

                  'was the string found?
                   If rowCopy <> 0 Then
                      rowPaste = rowPaste + 1
                      
                      'copy and paste
                      wsTarget.Range("A" & rowPaste).Value = lngId
                      wsTarget.Range("B" & rowPaste).Value = strId
                      wsSource.Range("C" & rowCopy & ":D" & rowCopy).Copy _
                         Destination:=wsTarget.Range("C" & rowPaste)
                   End If
              
                  If Not rngFound Is Nothing Then
                     Set rngFound = .FindNext(rngFound)
                  End If
                  
               Loop While Not rngFound Is Nothing And rngFound.Address <> strFoundAddress
            End If
         End With
      Next i
      
      'sort the output
      wsTarget.Range("A10").Sort _
        Key1:=wsTarget.Columns("A"), _
        Header:=xlGuess
      
   'tidy up
   Set wsSource = Nothing
   Set wsTarget = Nothing
   Set rngFound = Nothing
End Sub

 

[Dazzawm]

Thanks Bertie but that only work on a few numbers, if it makes a difference I have 10s of thousands of different numbers in column C.

 

[bertie]

This is probably due to the limited range to search on the source worksheet, i.e., Sheet2.
Replace this:

         With wsSource.Range("A2:D10")
            Set rngFound = .Find(strFind, LookIn:=xlValues)

with:

         'get the last row on the souce sheet
         lr = wsSource.Range("A" & Rows.Count).End(xlUp).Row
         With wsSource.Range("A2:D" & lr)

 

[Dazzawm]

I can see that it is doing what I need but again on only a few rows, even after changing as you say.

 

[bertie]

At my end the code is working on the sample data you posted.

The Target sheet is Sheet1.
We get the last populated row on sheet1, based on column A.
And loop through this range:

   'get the last row
   lr = wsTarget.Range("A" & Rows.Count).End(xlUp).Row
   rowPaste = lr


      For i = 10 To lr

The Source sheet we search through is sheet2.
Again we get the range to search based on the last populated row in column A.

         'get the last row on the souce sheet
         lr = wsSource.Range("A" & Rows.Count).End(xlUp).Row
         With wsSource.Range("A2:D" & lr)

Can you see anything here which would cause a problem?

 

[Dazzawm]

Not really, but I dont know what I am looking for!! Could I send you the file so you can see the exact layout?