Search Macro - Providing Multiple Results - Help with adding multiple cells from different sheets

[ColinW]

Hi,

I am using a macro that I got from SpreadsheetGuru as posted below. What it does is when I put in a search term, it uses filters to bring back my results. It works really well. However, I am looking to enhance this a little with possible index matching or vLookups.

When I return a search, I want it to display the questions associated with a unique code on sheet 2. What I want to do is, when my macro runs, I want some way to return the specific questions associated to that code, but not having them all in 1 row. Is this possible?

I've attached a sample sheet of what I have, but also put into sheet 3, what I would like to be displayed if possible. Can't attach macros as I can't send xlsm files over my network and they are on another machine (which is why I put them into cod tabs)

i.e.

Macro Runs

Sheet1 Cell B2 has unique code 'ABC123'

Sheet2 Cell D3 - E19 has 16 different questions associated to that code. Is there anyway I could have them disaplyed when my macro is run.

Sub SearchBox()
'PURPOSE: Filter Data on User-Determined Column & Text
'SOURCE: www.TheSpreadsheetGuru.com

Dim myButton As OptionButton
Dim MyVal AsLong
Dim ButtonName AsString
Dim sht As Worksheet
Dim myField AsLong
Dim DataRange As Range
Dim mySearch AsVariant

'Load Sheet into A Variable
Set sht = ActiveSheet

'Unfilter Data (if necessary)
OnErrorResumeNext
   sht.ShowAllData
OnErrorGoTo 0

'Filtered Data Range (include column heading cells)
Set DataRange = sht.Range("A4:E31") 'Cell Range
'Set DataRange = sht.ListObjects("Table1").Range 'Table

'Retrieve User's Search Input
 mySearch = sht.Shapes("UserSearch").TextFrame.Characters.Text 'Control Form
'mySearch = sht.OLEObjects("UserSearch").Object.Text 'ActiveX Control
'mySearch = sht.Range("A1").Value 'Cell Input

'Loop Through Option Buttons
ForEach myButton In ActiveSheet.OptionButtons
If myButton.Value = 1 Then
       ButtonName = myButton.Text
ExitFor
EndIf
Next myButton

'Determine Filter Field
OnErrorGoTo HeadingNotFound
   myField = Application.WorksheetFunction.Match(ButtonName, DataRange.Rows(1), 0)
OnErrorGoTo 0

'Filter Data
 DataRange.AutoFilter _
   Field:=myField, _
   Criteria1:="=*" & mySearch & "*", _
   Operator:=xlAnd

'Clear Search Field
 sht.Shapes("UserSearch").TextFrame.Characters.Text = "" 'Control Form
'sht.OLEObjects("UserSearch").Object.Text = "" 'ActiveX Control
'sht.Range("A1").Value = "" 'Cell Input

ExitSub

'ERROR HANDLERS
HeadingNotFound:
 MsgBox "The column heading [" & ButtonName & "] was not found in cells " & DataRange.Rows(1).Address & ". " & _
   vbNewLine & "Please check for possible typos.", vbCritical, "Header Name Not Found!"

EndSub

Sub ClearFilter()
'PURPOSE: Clear all filter rules

'Clear filters on ActiveSheet
OnErrorResumeNext
   ActiveSheet.ShowAllData
OnErrorGoTo 0

EndSub