Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Excel dependable Dropdowns

Posted on 2010-01-04
10
Medium Priority
?
688 Views
Last Modified: 2012-05-08
Excel issue (may be limitiation)...I tried to search for solutions but without any luck...I have attached the sample excel file for better understanding.

So, I need to set dropdown list for first 4 columns (Dependable dropdowns), my problem is if I select the region as west then I want only state, ID & code to be displayed for "West" region and if I select particular state then only related other filters should be displayed and update the data fields.

This is just a simple file, I am dealing with 5000+ rows and excel only is my option since this will be distributed. I tried looking up each row for particular value and check duplicates ect....but very slow and not the decent way to do it....

Any help would be greatly apprecaited.

Thank you.
sample1.xls
0
Comment
Question by:hitsdoshi1
  • 4
  • 3
  • 3
10 Comments
 
LVL 65

Expert Comment

by:RobSampson
ID: 26176139
Hi there, would something like this help?
http://www.contextures.com/xlDataVal02.html

I don't have the time to test it at the moment, but hopefully it helps you.

Regards,

Rob.
0
 
LVL 9

Author Comment

by:hitsdoshi1
ID: 26176225
This doesn't work since I have to fetch unique values from each column of 5K rows...
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 26178102
It looks like you may need to create a vlookup based on the first selection, that writes the matching states to another range (possibly hidden), then use the Data Validation source to get values from that new range.....

Rob.
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 9

Author Comment

by:hitsdoshi1
ID: 26178274
That's exactly what I need, but not sure  how to vlookup for the Unique values on non-sorted list and also I have to have vlookup result in array or in a list, which I can paste and point to validation list...
0
 
LVL 45

Expert Comment

by:patrickab
ID: 26185957
hitsdoshi1,

Please be patient - I will provide a solution, hopefully within an hour or so.

Patrick
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 26186259
OK Patrick's solution will probably be more elegant than mine, but what I've done is:
Cell C29 has an Advanced Filter with a Source of A2:A23 (the region list). I have selected Copy To Another Location, and Unique Records Only, which it has copied to $I$2
Cell 29 then also has Data Validation based on the new list at $I$2 to populate the C29 list box.
There is a Worksheet_Change macro that then generates a new valid State list in $I$2 for states that match the region.
Cell C30 then has Data Validation based on this list at $I$2

Regards,

Rob.
Q-25018525.xls
0
 
LVL 45

Expert Comment

by:patrickab
ID: 26186537
hitsdoshi1,

I need to finish it tomorrow - it's now late here.

Patrick
0
 
LVL 45

Accepted Solution

by:
patrickab earned 1000 total points
ID: 26189028
hitsdoshi1,

The code below is in the attached workbook. Make the selections from the dropdowns in the yellow cells and the totals will be shown below. The totals are produced using this sort of formula:

=SUMPRODUCT(($A$2:$A$10000=$J$1)*($B$2:$B$10000=$J$2)*($C$2:$C$10000=$M$1)*($D$2:$D$10000=$M$2)*$E$2:$E$10000)

Hope that helps

Patrick
In an ordinary VBA Module:

Option Explicit
Option Base 1

Sub region_dropdown()
Dim coll As New Collection
Dim rng As Range
Dim celle As Range
Dim str1 As String
Dim str2 As String
Dim rowe As Long
Dim i As Long
Dim n As Long
Dim temp As String
Dim coll_arr() As String

rowe = 2
str1 = "A"
str2 = "A"
With Sheets("Sheet1")
    Set rng = Range(.Cells(rowe, str1), .Cells(.Cells.Rows.Count, str2).End(xlUp))
End With

For Each celle In rng
        On Error Resume Next
        coll.Add celle, celle
Next celle

ReDim coll_arr(coll.Count)

For i = 1 To coll.Count
    coll_arr(i) = coll(i)
Next i

temp = ""
For n = 1 To coll.Count
    For i = 1 To coll.Count
        If coll_arr(n) < coll_arr(i) Then
            temp = coll_arr(n)
            coll_arr(n) = coll_arr(i)
            coll_arr(i) = temp
            If i = coll.Count Then
                coll_arr(coll.Count) = temp
            End If
            temp = ""
        End If
    Next i
Next n

With Sheets("Lists")
    For i = 1 To UBound(coll_arr)
        .Cells(i + 1, 1) = coll_arr(i)
    Next i
End With

End Sub

In Worksheet_Change for Sheet1:

Option Explicit
Option Base 1

Private Sub Worksheet_Change(ByVal Target As Range)
Dim coll As New Collection
Dim rng As Range
Dim celle As Range
Dim str1 As String
Dim str2 As String
Dim rowe As Long
Dim i As Long
Dim n As Long
Dim temp As String
Dim coll_arr() As String

'check for a change in the Region cell J1
If Not Intersect(Sheets("Sheet1").[J1], Target) Is Nothing Then
    rowe = 2
    str1 = "B"
    str2 = "B"
    With Sheets("Sheet1")
        Set rng = Range(.Cells(rowe, str1), .Cells(.Cells.Rows.Count, str2).End(xlUp))
    End With
    
    For Each celle In rng
        If celle.Offset(0, -1) = Sheets("Sheet1").[J1] Then
            On Error Resume Next
            coll.Add celle, celle
        End If
    Next celle
    
    On Error Resume Next
    ReDim coll_arr(coll.Count)
    
    For i = 1 To coll.Count
        coll_arr(i) = coll(i)
    Next i
    
    temp = ""
    For n = 1 To coll.Count
        For i = 1 To coll.Count
            If coll_arr(n) < coll_arr(i) Then
                temp = coll_arr(n)
                coll_arr(n) = coll_arr(i)
                coll_arr(i) = temp
                If i = coll.Count Then
                    coll_arr(coll.Count) = temp
                End If
                temp = ""
            End If
        Next i
    Next n
    
    With Sheets("Sheet1")
        .[J2].ClearContents
        .[M1].ClearContents
        .[M2].ClearContents
    End With
    
    With Sheets("Lists")
        .Range(.Cells(2, "B"), .Cells(65536, "B")).ClearContents
        For i = 1 To UBound(coll_arr)
            .Cells(i + 1, "B") = coll_arr(i)
        Next i
    End With
End If

'check for a change in the State cell J2
If Not Intersect(Sheets("Sheet1").[J2], Target) Is Nothing Then
    rowe = 2
    str1 = "C"
    str2 = "C"
    With Sheets("Sheet1")
        Set rng = Range(.Cells(rowe, str1), .Cells(.Cells.Rows.Count, str2).End(xlUp))
    End With
    
    For Each celle In rng
        If celle.Offset(0, -1) = Sheets("Sheet1").[J2] Then
            On Error Resume Next
            coll.Add celle, celle
        End If
    Next celle
    
    On Error Resume Next
    ReDim coll_arr(coll.Count)
    
    For i = 1 To coll.Count
        coll_arr(i) = coll(i)
    Next i
    
    temp = ""
    For n = 1 To coll.Count
        For i = 1 To coll.Count
            If coll_arr(n) < coll_arr(i) Then
                temp = coll_arr(n)
                coll_arr(n) = coll_arr(i)
                coll_arr(i) = temp
                If i = coll.Count Then
                    coll_arr(coll.Count) = temp
                End If
                temp = ""
            End If
        Next i
    Next n
    
    With Sheets("Sheet1")
        .[M1].ClearContents
        .[M2].ClearContents
    End With
    
    With Sheets("Lists")
        .Range(.Cells(2, "C"), .Cells(65536, "C")).ClearContents
        For i = 1 To UBound(coll_arr)
            .Cells(i + 1, "C") = coll_arr(i)
        Next i
    End With
End If

'check for a change in the ID cell M1
If Not Intersect(Sheets("Sheet1").[M1], Target) Is Nothing Then
    rowe = 2
    str1 = "D"
    str2 = "D"
    With Sheets("Sheet1")
        Set rng = Range(.Cells(rowe, str1), .Cells(.Rows.Count, str2).End(xlUp))
    End With
    
    For Each celle In rng
        If celle.Offset(0, -1) = Sheets("Sheet1").[M1] Then
            On Error Resume Next
            coll.Add CStr(celle), CStr(celle)
        End If
    Next celle
    On Error Resume Next
    ReDim coll_arr(coll.Count)
    
    For i = 1 To coll.Count
        coll_arr(i) = coll(i)
    Next i
    
    temp = ""
    For n = 1 To coll.Count
        For i = 1 To coll.Count
            If coll_arr(n) < coll_arr(i) Then
                temp = coll_arr(n)
                coll_arr(n) = coll_arr(i)
                coll_arr(i) = temp
                If i = coll.Count Then
                    coll_arr(coll.Count) = temp
                End If
                temp = ""
            End If
        Next i
    Next n

    Sheets("Sheet1").[M2].ClearContents
    With Sheets("Lists")
        .Range(.Cells(2, "D"), .Cells(65536, "D")).ClearContents
        For i = 1 To UBound(coll_arr)
            .Cells(i + 1, "D") = coll_arr(i)
        Next i
    End With
End If

End Sub

Open in new window

sample1-1-.xls
0
 
LVL 9

Author Closing Comment

by:hitsdoshi1
ID: 31672577
Perfect
0
 
LVL 45

Expert Comment

by:patrickab
ID: 26191755
hitsdoshi1 - Thanks for the grade - Patrick
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

581 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question