Thread: Search to find matching cells and copy/transpose adjacent data to original sheet?

Hello,

I'm trying to find a way to search a second sheet in a workbook for specific criteria outlined in a first sheet (in my attached example, from A3 downwards within the 'list of search criteria' sheet), and then to copy any secondary data found against a successful search match to the original sheet, transposed against its corresponding matched search term.

As you can see in the example, the search term 'bindi' (A4 in the 'list of search criteria' sheet) appears in the 'data' sheet 3 times - the secondary data for these occurences ('feathery', 'Fibonacci', 'glassy') is copied to the 'bindi' row on the first sheet and is offset with each copy to produce a transposed-esque effect of copy and paste.

If it's any help, there are a maximum of 9 matches for a single search term in the real document.

Thanks in advance for your help... I tried to adapt a previous solution given to me for a similar question but failed miserably. I bow humbly to your expertise!

Best,
Ian

Try this:

Code:

Option Explicit

Sub TransposeSecondaryValues()
'JBeaucaire  (11/11/2009)
'Turns columnar date on sheet into row data in another
Dim LR As Long, Rng As Range, cell As Range
Application.ScreenUpdating = False

Sheets("list of search criteria").Activate
Range("B3:J" & Rows.Count).ClearContents
LR = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("A3:A" & LR)

With Sheets("sheet 1 data")
    .Range("A1").AutoFilter
    For Each cell In Rng
        .Range("A1").AutoFilter Field:=1, Criteria1:=cell.Text
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        If LR > 1 Then
            .Range("B2:B" & LR).Copy
            cell.Offset(0, 1).PasteSpecial xlPasteValues, Transpose:=True
        End If
    Next cell
    .Range("A1").AutoFilter
End With

Application.ScreenUpdating = True
End Sub

Well, if your sheetname didn't match the example sheet you posted, perhaps other things don't match? Post up the sheet where you've installed the macro and it doesn't work as designed and I can compare directly.

Oops. Forgot to tell you. Remove that blank row2 on the data sheet.

We're using Autofilter and having a blank row at the top basically breaks the autofilter's ability to see the data as contiguous.

Fortunately, Autofilter is designed to allow sequential filtering, so this only required a couple of additional lines of code...plus editing the original code to match your changing layout.

Code:

Option Explicit

Sub TransposeSecondaryValues()
'JBeaucaire  (11/11/2009)
'Turns columnar date on sheet into row data in another
Dim LR As Long, Rng As Range, cell As Range
Application.ScreenUpdating = False

Sheets("criteria and results").Activate
Range("E2:M" & Rows.Count).ClearContents
LR = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("A2:A" & LR)

With Sheets("data")
    For Each cell In Rng
        .Range("A1").AutoFilter Field:=1, Criteria1:=cell.Text
        .Range("A1").AutoFilter Field:=2, Criteria1:=cell.Offset(0, 1).Text
        .Range("A1").AutoFilter Field:=3, Criteria1:=cell.Offset(0, 2).Text
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        If LR > 1 Then
            .Range("D2:D" & LR).Copy
            cell.Offset(0, 4).PasteSpecial xlPasteValues, Transpose:=True
        End If
        .Range("A1").AutoFilter
    Next cell
End With

Application.ScreenUpdating = True
End Sub

You can put an asterisk in a cell for the search2 or search3 criteria to get it to match all values.