http://www.contextures.com

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

Regards,

Rob.

Solved

Posted on 2010-01-04

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

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

10 Comments

http://www.contextures.com

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

Regards,

Rob.

Rob.

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

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

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

sample1-1-.xls
Title | # Comments | Views | Activity |
---|---|---|---|

VBA to delete range of cells in row NOT entire row | 11 | 32 | |

Excel Averageifs | 2 | 15 | |

VBA Object does not support property or method | 3 | 20 | |

Create exported XLS from Query | 19 | 13 |

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

Connect with top rated Experts

**20** Experts available now in Live!