Excel filter some data from other two sheets and copy back

SAGO_1304 Posts 1 Registration date Monday October 17, 2022 Status Member Last seen October 17, 2022 - Oct 17, 2022 at 10:13 AM
TrowaD Posts 2913 Registration date Sunday September 12, 2010 Status Moderator Last seen November 21, 2022 - Nov 1, 2022 at 12:56 PM

Hi,

I have some query related to excel where i have to get some results as described below:

Excel Sheet 1:

Sheet 1

Excel Sheet 2:

Sheet2

Excel Sheet 3:

Result sheet 3

 My Query:

1. In result sheet 3, i have Product and Part number

2. Based on the part number, i have to filter the data in sheet 1 and copy it to Result sheet 3 in the same row as highlighted in the image

3. similarly, with the same part number i have to filter the data in sheet 2 and copy it to Result sheet 3 in the same as highlighted in the image

4. Same will be followed to other part number

5. Some part number will not be available in either sheet 1 or sheet 2. So, based on the data availability it should get paste in the respective row by referring the part number.

6. if data not available, leave as empty as shown in the Result sheet 3.

Can anyone please guide me if possible in the excel sheet using formula bcoz we have huge data to filter those data and need to past manually. It is very hectic to do manually and so please let me know the possibilities as early as possible.

Thanks!

1 reply

TrowaD Posts 2913 Registration date Sunday September 12, 2010 Status Moderator Last seen November 21, 2022 541
Nov 1, 2022 at 12:56 PM

Hi Sago,

Check the following code and see if it performs as expected:
 

Sub RunMe()
Dim mFind, cell As Range
Dim fAddress As String
Dim cVal, x, lRow As Integer

Application.ScreenUpdating = False

Sheets("Sheet3").Select
Range("E3:Q" & Range("E" & Rows.Count).End(xlUp).Row).Delete

For Each cell In Sheets("Sheet3").Range("C3:C" & Range("C2").End(xlDown).Row)
    With Application.WorksheetFunction
        cVal = .Max(.CountIf(Sheets("Sheet1").Columns("C"), cell.Value), .CountIf(Sheets("Sheet2").Columns("C"), cell.Value))
    End With
    
    If cVal = 0 Then GoTo NextCell
    
    lRow = Sheets("Sheet3").Range("E" & Rows.Count).End(xlUp).Row

    With Sheets("Sheet3")
        x = 0
        .Select
        .Range(Cells(cell.Row, "B"), Cells(cell.Row, "C")).Copy
        Do
            x = x + 1
            .Range("E" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
        Loop Until x = cVal
    End With
    
    x = 1
    
    Set mFind = Sheets("Sheet1").Columns("C").Find(cell.Value)
    If Not mFind Is Nothing Then
        fAddress = mFind.Address
        Do
            Sheets("Sheet1").Select
            Sheets("Sheet1").Range(Cells(mFind.Row, "D"), Cells(mFind.Row, "H")).Copy
            Sheets("Sheet3").Range("G" & lRow + x).PasteSpecial
            x = x + 1
            Set mFind = Sheets("Sheet1").Columns("C").FindNext(mFind)
        Loop While mFind.Address <> fAddress
    End If
    
    x = 1
    
    Set mFind = Sheets("Sheet2").Columns("C").Find(cell.Value)
    If Not mFind Is Nothing Then
        fAddress = mFind.Address
        Do
            Sheets("Sheet2").Select
            Sheets("Sheet2").Range(Cells(mFind.Row, "D"), Cells(mFind.Row, "H")).Copy
            Sheets("Sheet3").Range("M" & lRow + x).PasteSpecial
            x = x + 1
            Set mFind = Sheets("Sheet2").Columns("C").FindNext(mFind)
        Loop While mFind.Address <> fAddress
    End If
    
NextCell:
Next cell
Application.ScreenUpdating = True
End Sub


Best regards,
Trowa


0