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%

Who is Participating?
Saqib Husain, SyedEngineerCommented:

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.


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.

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

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
    End If
End Sub

Open in new window


Sample File Attached.

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


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

Open in new window

Introducing Cloud Class® training courses

Tech changes fast. You can learn faster. That’s why we’re bringing professional training courses to Experts Exchange. With a subscription, you can access all the Cloud Class® courses to expand your education, prep for certifications, and get top-notch instructions.

Rob HensonFinance 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.

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

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

getDepts = Str(conCol)

End Function

Open in new window

Rob HensonFinance 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.

Rob H Adv-Filter.xls
JCJGAuthor 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?

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.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Cells.Count = 1 And Target.Address = "$B$1" Then
    End If
End Sub

Open in new window

Saqib Husain, SyedEngineerCommented:
>>>I have to copy the formulas as far down as to allow the maximum number of returns


>>>...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.

JCJGAuthor Commented:
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.

All Courses

From novice to tech pro — start learning today.