• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 308
  • Last Modified:

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
0
JCJG
Asked:
JCJG
  • 2
  • 2
  • 2
  • +3
2 Solutions
 
jppintoCommented:
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

Open in new window

ReturnMultipleValues-VBA.xlsm
0
 
Saqib Husain, SyedEngineerCommented:
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
 
SiddharthRoutCommented:
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

Open in new window



Sample.xls
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
Rob HensonIT & Database AssistantCommented:
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
 
theKashyapCommented:
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

Open in new window

0
 
Rob HensonIT & Database AssistantCommented:
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
0
 
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?


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

Open in new window

ReturnMultipleValues-VBA.xlsm
0
 
Saqib Husain, SyedEngineerCommented:
>>>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
 
JCJGAuthor Commented:
Thanks!
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 2
  • 2
  • 2
  • +3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now