Comboboxes
 

I want to create two comboboxes but i want the second one to show me only
relevant info from the first one.

For example

i have Australia,Usa for the first combobox
and the second one i want to show me only the cities of each country. So if
i choose australia i wish the second combobox to drop down only Sydney,
Perth

I wrote a code for this but something doesnot work in the second part..
Could anyone let me know what is wrong?

Thanks in advance

Angeliki


Option Explicit
Dim Data As Range
Dim LowestLevel As Long
Private Sub ComboBox1_click()

Dim rng As Range, cell As Range
Dim res As Variant
Dim varr() As String
Dim icnt As Long
Dim bFirst As Boolean
ReDim varr(1 To 50)
If ComboBox1.ListIndex < -1 Then
If LowestLevel 1 Then
Data.Parent.ShowAllData
End If
Worksheets("Database").Select
Worksheets("Database").AutoFilter.Range.AutoFilter Field:=1,
Criteria1:=ComboBox1.Value
LowestLevel = 2
ComboBox2.Clear
On Error Resume Next
Set rng = Data.Columns(2).SpecialCells(xlVisible)
On Error GoTo 0
bFirst = True
If rng Is Nothing Then
ComboBox2.Clear
Exit Sub
End If
End If
For Each cell In rng
If bFirst Then
ComboBox2.AddItem cell.Value
icnt = 1
varr(icnt) = cell.Value
bFirst = False
Else
res = Application.Match(cell.Value, varr, 0)
If IsError(res) Then
icnt = icnt + 1
varr(icnt) = cell.Value
ComboBox2.AddItem cell.Value
If icnt = UBound(varr) Then _
ReDim Preserve varr(1 To UBound(varr) + 50)
End If
End If
Next
ComboBox2.Clear
ComboBox2.ListIndex = -1
End Sub
Private Sub ComboBox2_click()
Dim rng As Range, cell As Range
Dim res As Variant
Dim varr() As String
Dim icnt As Long
Dim bFirst As Boolean
ReDim varr(1 To 50)
If ComboBox1.ListIndex < -1 Then
If LowestLevel 2 Then
Data.Parent.ShowAllData
Worksheets("Database").AutoFilter.Range.AutoFilter Field:=1, _
Criteria1:=ComboBox1.Value
End If
Worksheets("Database").AutoFilter.Range.AutoFilter Field:=2, _
Criteria1:=ComboBox2.Value
' Worksheets("Database").AutoFilter.Range _
' .AutoFilter Field:=3, _
' Criteria1:=ComboBox3.Value
LowestLevel = 2
Else
ComboBox2.Clear
ComboBox2.ListIndex = -1
End If
End Sub

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

Worksheets("Database").Select
Worksheets("Database").Cells(1, 1).Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Worksheets("Catastrophes").Select
Cells(1, 11).Select
ActiveSheet.Paste
Cells(1, 1).Select
Application.CutCopyMode = True

Unload UserForm1

End Sub

Private Sub UserForm_Initialize()
Dim rng As Range

With Worksheets("info")
Set rng = .Cells(1, 1).CurrentRegion.Columns(1)
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)
End With
ComboBox1.RowSource = rng.Address(external:=True)
With Worksheets("Database")
Set rng = .Cells(1, 1).CurrentRegion
If Not .AutoFilterMode Then
rng.AutoFilter
Else
If .FilterMode Then
.ShowAllData
End If
End If
Set Data = .AutoFilter.Range
Set Data = Data.Offset(1, 0).Resize( _
Data.Rows.Count - 1)
End With
End Sub

Comboboxes
 

Angeliki,

I have a workbook for doing this. All you need to do is plug in the values.
Mail me directly (not the signature anti-spam defence) if you want a copy.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Angeliki" wrote in message
...
I want to create two comboboxes but i want the second one to show me only
relevant info from the first one.

For example

i have Australia,Usa for the first combobox
and the second one i want to show me only the cities of each country. So
if
i choose australia i wish the second combobox to drop down only Sydney,
Perth

I wrote a code for this but something doesnot work in the second part..
Could anyone let me know what is wrong?

Thanks in advance

Angeliki


Option Explicit
Dim Data As Range
Dim LowestLevel As Long
Private Sub ComboBox1_click()

Dim rng As Range, cell As Range
Dim res As Variant
Dim varr() As String
Dim icnt As Long
Dim bFirst As Boolean
ReDim varr(1 To 50)
If ComboBox1.ListIndex < -1 Then
If LowestLevel 1 Then
Data.Parent.ShowAllData
End If
Worksheets("Database").Select
Worksheets("Database").AutoFilter.Range.AutoFilter Field:=1,
Criteria1:=ComboBox1.Value
LowestLevel = 2
ComboBox2.Clear
On Error Resume Next
Set rng = Data.Columns(2).SpecialCells(xlVisible)
On Error GoTo 0
bFirst = True
If rng Is Nothing Then
ComboBox2.Clear
Exit Sub
End If
End If
For Each cell In rng
If bFirst Then
ComboBox2.AddItem cell.Value
icnt = 1
varr(icnt) = cell.Value
bFirst = False
Else
res = Application.Match(cell.Value, varr, 0)
If IsError(res) Then
icnt = icnt + 1
varr(icnt) = cell.Value
ComboBox2.AddItem cell.Value
If icnt = UBound(varr) Then _
ReDim Preserve varr(1 To UBound(varr) + 50)
End If
End If
Next
ComboBox2.Clear
ComboBox2.ListIndex = -1
End Sub
Private Sub ComboBox2_click()
Dim rng As Range, cell As Range
Dim res As Variant
Dim varr() As String
Dim icnt As Long
Dim bFirst As Boolean
ReDim varr(1 To 50)
If ComboBox1.ListIndex < -1 Then
If LowestLevel 2 Then
Data.Parent.ShowAllData
Worksheets("Database").AutoFilter.Range.AutoFilter Field:=1, _
Criteria1:=ComboBox1.Value
End If
Worksheets("Database").AutoFilter.Range.AutoFilter Field:=2, _
Criteria1:=ComboBox2.Value
' Worksheets("Database").AutoFilter.Range _
' .AutoFilter Field:=3, _
' Criteria1:=ComboBox3.Value
LowestLevel = 2
Else
ComboBox2.Clear
ComboBox2.ListIndex = -1
End If
End Sub

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

Worksheets("Database").Select
Worksheets("Database").Cells(1, 1).Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Worksheets("Catastrophes").Select
Cells(1, 11).Select
ActiveSheet.Paste
Cells(1, 1).Select
Application.CutCopyMode = True

Unload UserForm1

End Sub

Private Sub UserForm_Initialize()
Dim rng As Range

With Worksheets("info")
Set rng = .Cells(1, 1).CurrentRegion.Columns(1)
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)
End With
ComboBox1.RowSource = rng.Address(external:=True)
With Worksheets("Database")
Set rng = .Cells(1, 1).CurrentRegion
If Not .AutoFilterMode Then
rng.AutoFilter
Else
If .FilterMode Then
.ShowAllData
End If
End If
Set Data = .AutoFilter.Range
Set Data = Data.Offset(1, 0).Resize( _
Data.Rows.Count - 1)
End With
End Sub