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

Hi, I have the following data and would like to return a list of dept # (with value greater than zero) based on the country specified in a cell.  For example, if the cell value is "U.S." then it returns dept # 10, 40, 50.  If the cell value is "France" then it returns dept # 20 and 40.  How do I do this?  Do I need to use vba.  I have attached a file for your reference.  Thanks.

Dept #      U.S.      France      Japan
10      100%
20            100%
30                  100%
40      30%      20%      50%
50      90%            10%

Book1.xlsx
###### Who is Participating?

EngineerCommented:
THIS IS AN ARRAY FORMULA AND SHOULD BE ENTERED BY PRESSING CTRL-SHIFT-ENTER

Enter this formula in B4and drag it down. If your data on sheet2 extends below row 20 you can modify the 20's in the formula.

=IF(ISNA(MATCH(0,COUNTIF(B\$3:B3,IF(OFFSET(data!\$A\$1,1,MATCH(\$B\$1,data!\$1:\$1,0)-1,100,1),data!\$A\$2:\$A\$20,"")&""),0)),"",INDEX(IF(ISBLANK(data!\$A\$2:\$A\$20),"",data!\$A\$2:\$A\$20),MATCH(0,COUNTIF(B\$3:B3,IF(OFFSET(data!\$A\$1,1,MATCH(\$B\$1,data!\$1:\$1,0)-1,100,1),data!\$A\$2:\$A\$20,"")&""),0)))

Saqib
0

Commented:
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
``````
ReturnMultipleValues-VBA.xlsm
0

Commented:
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
``````

Sample.xls
0

Finance AnalystCommented:
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
0

Commented:
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
``````
0

Finance AnalystCommented:
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
0

Author Commented:
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?

0

Commented:
Yes, this macro was build to be used on the "Main" sheet, when you change the value on cell B1. Instead of putting the code on the "Main" sheet, you can place the code on the Workbook and put the code running on the Workbook_SheetChange event. Take a look at the attached file.

jppinto
``````Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count = 1 And Target.Address = "\$B\$1" Then
ReturnValues
End If
End Sub
``````
ReturnMultipleValues-VBA.xlsm
0

EngineerCommented:
>>>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
0

Author Commented:
Thanks!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.