Excel Userform Change Event code if 2 Comboboxes are used, or if 1 is used more than once.

M

mafallaize

New Member
Joined
Aug 23, 2011
Messages
31
Hi guys,

Last time I posted on this site, I quickly received amazing responses especially from Mike, so I'm back again with a tricky problem because you guys are so helpful on this site!

I'm trying to build a userform which basically looks like this: Storage tank liquid volume calculator - Regal Tanks (the vertical height option), but with combo boxes.

Here's what I've done so far:

I have 2 tables on different sheets with the headers: [TABLE="width: 880"]
<tbody>[TR]
[TD="class: xl63, width: 88"]Volume[/TD]
[TD="width: 88"]Diameter[/TD]
[TD="width: 88"]Height M[/TD]
[TD="width: 88"]Height B[/TD]
[TD="width: 88"]Leg Height[/TD]
[TD="width: 88"]Height total[/TD]
[TD="width: 88"]M thickness[/TD]
[TD="width: 88"]B thickness[/TD]
[TD="width: 88"]weight[/TD]
[TD="width: 88"]price[/TD]
[/TR]
</tbody>[/TABLE]

When a user enters their chosen volume, diameter and height into the userform, the following array formula looks up the corresponding values: =IF($C$7="Price 3",INDEX('Price 3'!$A:$A,MATCH(1,($C$11='Price 3'!$B:$B)*($C$15='Price 3'!$F:$F),0)),INDEX('Price 6'!$A:$A,MATCH(1,($C$11='Price 6'!$B:$B)*($C$15='Price 6'!$F:$F),0))). This formula is copied down in another small table which looks like this:

[TABLE="width: 88"]
<tbody>[TR]
[TD="class: xl65, width: 88"]Volume[/TD]
[/TR]
[TR]
[TD="class: xl66"]Diameter[/TD]
[/TR]
[TR]
[TD="class: xl67"]Height M[/TD]
[/TR]
[TR]
[TD="class: xl67"]Height B[/TD]
[/TR]
[TR]
[TD="class: xl67"]Leg Height[/TD]
[/TR]
[TR]
[TD="class: xl66"]Height total[/TD]
[/TR]
[TR]
[TD="class: xl67"]M thickness[/TD]
[/TR]
[TR]
[TD="class: xl67"]B thickness[/TD]
[/TR]
[TR]
[TD="class: xl67"]Weight[/TD]
[/TR]
[TR]
[TD="class: xl67"]Price
[/TD]
[/TR]
</tbody>[/TABLE]
The volume, diameter and height total values are copied from the userform entries.

I'm using a table like this:

[TABLE="width: 795"]
<tbody>[TR]
[TD="class: xl65, width: 136"]Diameter Options H[/TD]
[TD="class: xl65, width: 135"]Diameter Options V[/TD]
[TD="class: xl65, width: 123"]Height Options D[/TD]
[TD="class: xl65, width: 137"]Height Options V[/TD]
[TD="class: xl65, width: 139"]Volume Options D[/TD]
[TD="class: xl65, width: 125"]Volume Options H[/TD]
[/TR]
</tbody>[/TABLE]

to hold the values which the combo boxes use with the array formula: =IF(ISERROR(INDEX('Price 3'!$A$1:$F$1000,SMALL(IF('Price 3'!$A$1:$A$1000=$C$6,ROW('Price 3'!A$1:$A$1000)),ROW(1:1)),2)),"",INDEX('Price 3'!$A$1:$F$1000,SMALL(IF('Price 3'!$A$1:$A$1000=$C$6,ROW('Price 3'!$A$1:$A$1000)),ROW(1:1)),2))

A user can choose 2 or 3 measurements from volume, diameter and height total. If they use the combobox for 1 measurement, a change event triggers, which updates the list for the other 2. I'm currently using
Code: 
Me.EnableEvents = False
to prevent a second combobox entry triggering an event to update the first, (which would cancel the user's initial entry).

My 2 problems are:

1. If a user enters say diameter in one combobox, then changes his mind and changes the diameter entry again, the change event wont fire because I've cancelled it with
Code: 
Me.EnableEvents = False[/CODE

2. If a user enters all 3 measurements, the second combobox won't fire to update the third combobox values.

Here's my code:

[CODE]   Public EnableEvents As Boolean
Private Sub CommandButton1_Click()
Worksheets("Test").Range("C4").Value = Diameter.Value
Worksheets("Test").Range("C5").Value = HeightT.Value
Worksheets("Test").Range("C6").Value = Volume.Value
Worksheets("Test").Range("C7").Value = Pricelist.Value
Worksheets("Test").Columns("K:p").Hidden = True
Unload Me
Worksheets("Test").Activate
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_Initialize()
Dim i As Long, J As Long, k As Integer
Dim colList As Collection


Application.ScreenUpdating = False
Me.EnableEvents = True


'clear values
Sheets("Processor").Select
Range("A1:B2000").Clear
Sheets("Test").Select
Range("C4:C7").Clear


'sort values
    Sheets("Price 3").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Processor").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Price 3").Select
    Range("F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Processor").Select
    Range("B1").Select
    ActiveSheet.Paste
    Columns("A:A").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Processor").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Processor").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Processor").Sort
        .SetRange Range("A1:A194")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("B:B").Select
    ActiveWorkbook.Worksheets("Processor").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Processor").Sort.SortFields.Add Key:=Range("B1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Processor").Sort
        .SetRange Range("B2:B194")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Sheets("Test").Select


'Set Diameter Values
Set colList = New Collection
With Worksheets("Price 3")
    For i = 2 To 2000
        On Error Resume Next
        colList.Add .Cells(i, 2).Value, CStr(.Cells(i, 2))
    Next i
    
    For J = 1 To colList.Count
        Me.Diameter.AddItem colList(J)
        Next J
End With


'Set Height Total Values
Set colList2 = New Collection
With Worksheets("Processor")
    For i = 2 To 2000
        On Error Resume Next
        colList2.Add .Cells(i, 2).Value, CStr(.Cells(i, 2))
    Next i
    
    For J = 1 To colList2.Count
        Me.HeightT.AddItem colList2(J)
        Next J
End With


'Set Volume Values
Set colList3 = New Collection
With Worksheets("Processor")
    For i = 2 To 2000
        On Error Resume Next
        colList3.Add .Cells(i, 1).Value, CStr(.Cells(i, 1))
    Next i
    
    For J = 1 To colList3.Count
        Me.Volume.AddItem colList3(J)
        Next J
End With


With Pricelist


.AddItem ("Price 3")
.AddItem ("Price 6")


End With


End Sub
Private Sub Diameter_Change()


If Me.EnableEvents = False Then
Exit Sub
End If


Worksheets("Test").Range("C4").Value = Diameter.Value
Worksheets("Test").Columns("K:p").Hidden = False


Call HeightUpdateD
Call VolumeUpdateD
Me.EnableEvents = False


End Sub
Private Sub HeightT_Change()


If Me.EnableEvents = False Then
Exit Sub
End If


Worksheets("Test").Range("C5").Value = HeightT.Value
Worksheets("Test").Columns("K:p").Hidden = False


Call DiameterUpdateH
Call VolumeUpdateH
Me.EnableEvents = False


End Sub
Private Sub Volume_Change()


If Me.EnableEvents = False Then
Exit Sub
End If


Worksheets("Test").Range("C6").Value = Volume.Value
Worksheets("Test").Columns("K:p").Hidden = False


Call HeightUpdateV
Call DiameterUpdateV
Me.EnableEvents = False


End Sub
Sub DiameterUpdateH()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
Me.Diameter.Clear


Dim i As Long, J As Long
Dim colList As Collection


Set colList = New Collection
With Worksheets("Test")
    For i = 4 To 20
        On Error Resume Next
        colList.Add .Cells(i, 11).Value, CStr(.Cells(i, 11))
    Next i
    
    For J = 1 To colList.Count
        Me.Diameter.AddItem colList(J)
        Next J
End With
Application.ScreenUpdating = True
End Sub
Sub DiameterUpdateV()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
Me.Diameter.Clear


Dim i As Long, J As Long
Dim colList As Collection


Set colList = New Collection
With Worksheets("Test")
    For i = 4 To 20
        On Error Resume Next
        colList.Add .Cells(i, 12).Value, CStr(.Cells(i, 12))
    Next i
    
    For J = 1 To colList.Count
        Me.Diameter.AddItem colList(J)
        Next J
End With
Application.ScreenUpdating = True
End Sub
Sub HeightUpdateD()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
Me.HeightT.Clear


Dim i As Long, J As Long
Dim colList As Collection


Set colList = New Collection
With Worksheets("Test")
    For i = 4 To 20
        On Error Resume Next
        colList.Add .Cells(i, 13).Value, CStr(.Cells(i, 13))
    Next i
    
    For J = 1 To colList.Count
        Me.HeightT.AddItem colList(J)
        Next J
End With
Application.ScreenUpdating = True
End Sub
Sub HeightUpdateV()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
Me.HeightT.Clear


Dim i As Long, J As Long
Dim colList As Collection


Set colList = New Collection
With Worksheets("Test")
    For i = 4 To 20
        On Error Resume Next
        colList.Add .Cells(i, 14).Value, CStr(.Cells(i, 14))
    Next i
    
    For J = 1 To colList.Count
        Me.HeightT.AddItem colList(J)
        Next J
End With
Application.ScreenUpdating = True
End Sub
Sub VolumeUpdateD()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
Me.Volume.Clear


Dim i As Long, J As Long
Dim colList As Collection


Set colList = New Collection
With Worksheets("Test")
    For i = 4 To 20
        On Error Resume Next
        colList.Add .Cells(i, 15).Value, CStr(.Cells(i, 15))
    Next i
    
    For J = 1 To colList.Count
        Me.Volume.AddItem colList(J)
        Next J
End With
Application.ScreenUpdating = True
End Sub
Sub VolumeUpdateH()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic
Me.Volume.Clear


Dim i As Long, J As Long
Dim colList As Collection


Set colList = New Collection
With Worksheets("Test")
    For i = 4 To 20
        On Error Resume Next
        colList.Add .Cells(i, 16).Value, CStr(.Cells(i, 16))
    Next i


    For J = 1 To colList.Count
        Me.Volume.AddItem colList(J)
        Next J
End With
Application.ScreenUpdating = True
End Sub
Perhaps there's a simple way to order the change events so that the combo boxes are updated when needed?


I look forward to your replies!

Regards

Mark
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
The problem lies in the following code. I need the 1 remaining combobox to update if the 2 other comboxes have been changed, and if a combobox has been used more than once, it needs to update again. Can anyone help?

Code: 
[COLOR=#333333]Private Sub Diameter_Change()[/COLOR]

If Me.EnableEvents = False Then
Exit Sub
End If


Worksheets("Test").Range("C4").Value = Diameter.Value
Worksheets("Test").Columns("K:p").Hidden = False


Call HeightUpdateD
Call VolumeUpdateD
Me.EnableEvents = False


End Sub
Private Sub HeightT_Change()


If Me.EnableEvents = False Then
Exit Sub
End If


Worksheets("Test").Range("C5").Value = HeightT.Value
Worksheets("Test").Columns("K:p").Hidden = False


Call DiameterUpdateH
Call VolumeUpdateH
Me.EnableEvents = False


End Sub
Private Sub Volume_Change()


If Me.EnableEvents = False Then
Exit Sub
End If


Worksheets("Test").Range("C6").Value = Volume.Value
Worksheets("Test").Columns("K:p").Hidden = False


Call HeightUpdateV
Call DiameterUpdateV
Me.EnableEvents = False

 [COLOR=#333333]End Sub[/COLOR]
 
Upvote 0
You must log in or register to reply here.

Similar threads

Z
  • Question Question
VBA Process Flow Chart using Shapes & Connectors
Replies
2
Views
139
zlotowlosapl
Z
M
  • Question Question
VBA changing values in multiple columns - where it should only be changing a single column
Replies
1
Views
345
Akuini
Akuini
P
  • Question Question
RUNTIME ERROR 91 for USERFORM CODE
Replies
1
Views
47
6StringJazzer
6StringJazzer
O
  • Question Question
Creating workbooks for a team of staff
Replies
1
Views
188
HighAndWilder
H
R
  • Question Question
VBA - AUTO FIT, Can we remove make the sum formula in below code
Replies
1
Views
151
Joe4
Joe4

Forum statistics

Threads
1,223,214
Messages
6,170,774
Members
452,353
Latest member
strainu

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top