Excel 2007: Return data based on value in a specific cell

You will need to use a macro for that. Please take a look at the attached example. It will pick the values on column B when you change the selection in cell B1 of sheet Main.

jppinto

Sub ReturnValues()
Dim lstRow As Long
Dim lstCol As Long
Dim wsdata As Worksheet
Dim wsmain As Worksheet
Dim x As Long
Dim y As Long
Dim counter As Long

Set wsdata = Sheets("data")
Set wsmain = Sheets("Main")
counter = 4
wsmain.Range("B4:b100").Clear

lstRow = wsdata.Cells(wsdata.Rows.Count, "A").End(xlUp).Row
lstCol = wsdata.Cells(1, wsdata.Columns.Count).End(xlToLeft).Column

For x = 2 To lstCol
    If wsmain.Cells(1, 2).Value = wsdata.Cells(1, x).Value Then
        For y = 2 To lstRow
            If wsdata.Cells(y, x).Value <> "" Then
                wsmain.Cells(counter, 2).Value = wsdata.Cells(y, 1).Value
                counter = counter + 1
            End If
        Next y
    End If
Next x

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count = 1 And Target.Address = "$B$1" Then
        ReturnValues
    End If
End Sub

Select allOpen in new window

ReturnMultipleValues-VBA.xlsm

NOT FOR POINTS

Sample File Attached.

Since I had already started working on it, I will post the solution :)

Sid

Code Used

Private Sub CommandButton1_Click()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim acell As Range, strSearch As String
    Dim cCol As Long, LastRow As Long, i As Long
    Dim rRow As Long
    
    Set ws1 = ActiveSheet
    Set ws2 = Sheets("Data")
    
    ws1.Range("B4:B" & Rows.Count).ClearContents
    
    rRow = 4
    
    If Len(Trim(ws1.Range("B1").Value)) = 0 Then
        MsgBox "There is no value in Cell B1"
        Exit Sub
    End If
    
    strSearch = Trim(ws1.Range("B1").Value)
    
    Set acell = ws2.Rows(1).Find(What:=strSearch, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    
    If Not acell Is Nothing Then
        cCol = acell.Column
        LastRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
        For i = 2 To LastRow
            If ws2.Cells(i, cCol).Value > 0 Then
               ws1.Cells(rRow, 2).Value = ws2.Cells(i, 1).Value
               rRow = rRow + 1
            End If
        Next i
    End If
End Sub

Select allOpen in new window

Sample.xls

You don't need to use VBA at all.

You can use the Advanced Filter function. The slight change to usual Advanced Filter is that you are changing the column header for the column to filter rather than the criteria.

You can filter in place or you can copy to another location on the same sheet.

If you do use VBA, you can set the Advanced Filter to copy to a specific range which can be on another sheet.

Cheers
Rob H

I guess there too many solns already.. but here is mine as well :)

Add the following code to a new module inside your excel (or the global if you want it somewhere else as well). If you donno:
- Alt+F11
- Right click on VBAProject (Book1.xls) on LHS
- Insert -> Module
- Paste the code into the window that opens on left.
- Alt+F4

Then type in the formula "=getDepts(B1)" in any cell to get the list you want.
Can be easily modified to print results in different cells.

Public Function getDepts(country As String) As String

getDepts = ""
Dim conCol As Integer
conCol = 2

Do While True
    v = Sheet2.Cells(1, conCol).Value
    If v = "" Then
        getDepts = "Unknown country"
        Exit Function
    ElseIf v = country Then
        Exit Do
    End If
    conCol = conCol + 1
Loop

nrow = 2
Do While True
    v = Sheet2.Cells(nrow, conCol).Value
    If CInt(v) > 0 Then
        getDepts = getDepts + ", " + CStr(Sheet2.Cells(nrow, 1).Value)
    ElseIf v = "" And Sheet2.Cells(nrow, 1).Value = "" Then
        getDepts = Right(getDepts, Len(getDepts) - 2)
        Exit Function
    End If

    nrow = nrow + 1
Loop

getDepts = Str(conCol)

End Function

Select allOpen in new window

See attached after using Advanced Filter.

I have set the criteria area and the copy location on the Data sheet. The list on the result sheet is then linked to the result area.

To update for new country, change the dropdown on main sheet, go to data sheet and put cursor in the data table, (top left preferably). Run the Advanced Filter function from the Data menu and choose Copy to Another location if not already selected, the other fields (Data source and Criteria) should already be filled in. When filter has finished the new data should now be showing in main sheet. I have put the formulae down to row 20 so you may need to extend this for the real data.

This can be automated with VBA if so required and the destination for the filtered data can be set to the Main sheet rather than being linked by formulae.

Cheers
Rob H Adv-Filter.xls

Thanks for the overwheming responses.  I appreciate all your help!

I have tried out all the solutions and found the ones from jppinto and ssaqibh best fit my need.  Here is my feedback/questions to these 2 solutions.

jppinto - I believe the macro is specific to the "Main" tab.  I need to duplicate this tab to have different value in the Country field which return different sets of dept #.  But the macro won't carry over when I duplicate the tab or add rows/columns or move cell positions in the worksheet.  Is it possible to modify the code to make this dynamic instead of hard-coded?

ssaqibh - I don't have the above issues using the array formulas.  The only thing is I have to copy the formulas as far down as to allow the maximum number of returns.  I assume there is no way around it?  In addition, is there a way besides cell protection to prevent user from accidentally go into the formula and not press CTRL-SHIFT-ENTER when exit?

>>>I have to copy the formulas as far down as to allow the maximum number of returns

Yes

>>>...is there a way besides cell protection to prevent user from accidentally...

None that I know of. You might like to insert a comment reminding you of it.

Saqib

Thanks!