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:
VolumeDiameterHeight MHeight BLeg HeightHeight totalM thicknessB thicknessweightprice

<tbody>
</tbody>

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:

Volume
Diameter
Height M
Height B
Leg Height
Height total
M thickness
B thickness
Weight
Price

<tbody>
</tbody>
The volume, diameter and height total values are copied from the userform entries.

I'm using a table like this:

Diameter Options HDiameter Options VHeight Options DHeight Options VVolume Options DVolume Options H

<tbody>
</tbody>

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

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
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

P
  • Question
Code used for comparison between 2 list.
Replies
3
Views
306
Tupe77
T
S
  • Question
Worksheet Change Event
Replies
2
Views
377
sspatriots
S
togenmoser
  • Solved
Help with VBA code error "For variable already in use"
2 3
Replies
22
Views
328
MARK858
MARK858
H
  • Solved
Amend the VBA code to Filter Columns Instead of Rows
Replies
9
Views
159
Akuini
Akuini
M
  • Question
Help with VBA code when selecting next sheet in workbook
Replies
3
Views
193
StephenCrump
S

Forum statistics

Threads
1,214,878
Messages
6,122,062
Members
449,064
Latest member
scottdog129

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