Search function in Excel issues

[dan_sherbs]

Hi Guys,

I have a knowledge Database Which has a different tab/worksheet for each location (ie London, Paris, Madrid etc). The structure of each Tab is the same with the Question in Column B & the Answer in Column C.

On a separate tab/worksheet (called Search) I have a User input cell in B2 & a button that runs the below macros and searches the data and returns the relevant question in Column A and the corrsponding answer in column B for all relevant records.

Its partly working but..
1. Not putting the Question from Column B into the results section in worksheet 'Search' in column A (starting at row 7)
2. Not putting the Answer from Column C into the results section in worksheet 'Search' in column B matching the Question above
3. Where it says Set ws = Worksheets("London") can i change it so the user can input London or Paris into an empty cell (say B3 in worksheet 'Search') and therefore the search just searches the correct tab based on user selection?

Many thanks & code below that needs editing!

Cheers
Dan


Private Function FindParts(PartNumber As String) As Variant
Dim ws As Worksheet
Dim FoundCell As Range
Dim LastCell As Range
Dim rngParts As Range
Dim FirstAddr As String
Dim arrPart() As Variant Set ws = Worksheets("London")
Set rngParts = ws.Range("B2:C" & ws.Cells(Rows.CountLarge, "B").End(xlUp).Row)
With rngParts
Set LastCell = .Cells(.Cells.Count)
End With
Set FoundCell = rngParts.Find(What:=PartNumber, After:=LastCell, LookAt:=xlPart)
If Not FoundCell Is Nothing Then
FirstAddr = FoundCell.Address
End If

ReDim arrPart(1 To 2, 1 To 1)
Do Until FoundCell Is Nothing
arrPart(1, UBound(arrPart, 2)) = FoundCell.Offset(0, -1)
arrPart(2, UBound(arrPart, 2)) = FoundCell.Value

ReDim Preserve arrPart(1 To 2, 1 To UBound(arrPart, 2) + 1)
Set FoundCell = rngParts.FindNext(After:=FoundCell)
If FoundCell.Address = FirstAddr Then
Exit Do
End If
Loop
FindParts = arrPart
End Function