4
\$\begingroup\$

I've designed a userform in Excel and it has many comboboxes and textbox inputs, once the user is done it puts ticks in appropriate columns depending on the ComboBox selection and also writes the value of the TextBox to the sheet.

At the moment I feel as though the sub could be refined but am unsure how to proceed as the ComboBoxes are not regular in the number of options each have.

I was thinking of using .listindex in place of the offset number. Any thoughts on proceeding with that?

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Projects.EnableMisc = False And Cells(ActiveCell.Row, 1).Value = "New" Then 'sets the save data for misc if it's not turned, so that if it is enabled it has some settings and the checkboxes are not set to triple state.
 Cells(ActiveCell.Row, Range("SaveMisc1").Column).Value = 0
 Cells(ActiveCell.Row, Range("SaveMisc2").Column).Value = 0
 Cells(ActiveCell.Row, Range("SaveXMisc1").Column).Value = False
 Cells(ActiveCell.Row, Range("SaveXMisc2").Column).Value = False
End If
Dim RangeName As String
Dim dblTBox As Double
Range(ActiveCell, Cells(ActiveCell.Row, Range("CostBuilding").Column)).ClearContents 'clears contents incase changes are made, this prevents multiple ticks showing in a single section
'writes the project name into the first column
Cells(ActiveCell.Row, 1).Value = Me.TextBoxName
'writes the ticks to the sheet
RangeName = "ProjFeasibility"
dblTBox = Me.TextBoxFeasibility.Value
Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 2).Value = dblTBox
Select Case Me.ComboBoxFeasibility.Value
 Case "Yes"
 Cells(ActiveCell.Row, Range(RangeName).Column).Value = "ü"
 Case Else
End Select
RangeName = "ProjConcept"
dblTBox = Me.TextBoxConcept.Value
Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 4).Value = dblTBox
Select Case Me.ComboBoxConcept.Value
 Case "Review"
 Cells(ActiveCell.Row, Range(RangeName).Column).Value = "ü"
 Case "Large"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 1).Value = "ü"
 Case "Medium"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 2).Value = "ü"
 Case "Small"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 3).Value = "ü"
 Case Else
End Select
RangeName = "ProjDetail"
dblTBox = Me.TextBoxDetail.Value
Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 4).Value = dblTBox
Select Case Me.ComboBoxDetail.Value
 Case "Review"
 Cells(ActiveCell.Row, Range(RangeName).Column).Value = "ü"
 Case "Large"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 1).Value = "ü"
 Case "Medium"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 2).Value = "ü"
 Case "Small"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 3).Value = "ü"
 Case Else
End Select
RangeName = "ProjLandscape"
dblTBox = Me.TextBoxLandscape.Value
Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 3).Value = dblTBox
Select Case Me.ComboBoxLandscape.Value
 Case "Parks Team"
 Cells(ActiveCell.Row, Range(RangeName).Column).Value = "ü"
 Case "Preliminary"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 1).Value = "ü"
 Case "Detail"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 2).Value = "ü"
 Case Else
End Select
RangeName = "ProjLighting"
dblTBox = Me.TextBoxLighting.Value
Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 3).Value = dblTBox
Select Case Me.ComboBoxLighting.Value
 Case "Minor"
 Cells(ActiveCell.Row, Range(RangeName).Column).Value = "ü"
 Case "Streets"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 1).Value = "ü"
 Case "Oval"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 2).Value = "ü"
 Case Else
End Select
RangeName = "ProjRSA"
dblTBox = Me.TextBoxRSA.Value
Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 2).Value = dblTBox
Select Case Me.ComboBoxRSA.Value
 Case "Yes"
 Cells(ActiveCell.Row, Range(RangeName).Column).Value = "ü"
 Case Else
End Select
RangeName = "ProjSurvey"
dblTBox = Me.TextBoxSurvey.Value
Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 3).Value = dblTBox
Select Case Me.ComboBoxSurvey.Value
 Case "Large"
 Cells(ActiveCell.Row, Range(RangeName).Column).Value = "ü"
 Case "Medium"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 1).Value = "ü"
 Case "Small"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 2).Value = "ü"
 Case Else
End Select
RangeName = "ProjGeotech"
dblTBox = Me.TextBoxGeotech.Value
Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 3).Value = dblTBox
Select Case Me.ComboBoxGeotech.Value
 Case "Large"
 Cells(ActiveCell.Row, Range(RangeName).Column).Value = "ü"
 Case "Medium"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 1).Value = "ü"
 Case "Small"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 2).Value = "ü"
 Case Else
End Select
RangeName = "ProjService"
dblTBox = Me.TextBoxService.Value
Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 3).Value = dblTBox
Select Case Me.ComboBoxService.Value
 Case "Large"
 Cells(ActiveCell.Row, Range(RangeName).Column).Value = "ü"
 Case "Medium"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 1).Value = "ü"
 Case "Small"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 2).Value = "ü"
 Case Else
End Select
RangeName = "ProjVegetation"
dblTBox = Me.TextBoxVegetation.Value
Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 3).Value = dblTBox
Select Case Me.ComboBoxVegetation.Value
 Case "Large"
 Cells(ActiveCell.Row, Range(RangeName).Column).Value = "ü"
 Case "Medium"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 1).Value = "ü"
 Case "Small"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 2).Value = "ü"
 Case Else
End Select
RangeName = "ProjOffset"
dblTBox = Me.TextBoxOffset.Value
Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 3).Value = dblTBox
Select Case Me.ComboBoxOffset.Value
 Case "Large"
 Cells(ActiveCell.Row, Range(RangeName).Column).Value = "ü"
 Case "Medium"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 1).Value = "ü"
 Case "Small"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 2).Value = "ü"
 Case Else
End Select
RangeName = "ProjCHMP"
dblTBox = Me.TextBoxCHMP.Value
Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 3).Value = dblTBox
Select Case Me.ComboBoxCHMP.Value
 Case "Due Diligence"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 1).Value = "ü"
 Case "Full"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 2).Value = "ü"
 Case Else
End Select
RangeName = "ProjPlanning"
dblTBox = Me.TextBoxPlanning.Value
Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 2).Value = dblTBox
Select Case Me.ComboBoxPlanning.Value
 Case "Yes"
 Cells(ActiveCell.Row, Range(RangeName).Column).Value = "ü"
 Case Else
End Select
RangeName = "ProjBuilding"
dblTBox = Me.TextBoxBuilding.Value
Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 2).Value = dblTBox
Select Case Me.ComboBoxBuilding.Value
 Case "Yes"
 Cells(ActiveCell.Row, Range(RangeName).Column).Value = "ü"
 Case Else
End Select
'autofills the sum formulas
Range("ProjAutoFill").AutoFill Destination:=Range("ProjAutoFill:LRowFill")
'writes the current values of options to sheet so that it can be accessed by the EditUserForm sub so that the form "remembers" what was selected
Cells(ActiveCell.Row, Range("CanEdit").Column).Value = "Y"
Cells(ActiveCell.Row, Range("SaveFeasibility").Column).Value = ComboBoxFeasibility.ListIndex
Cells(ActiveCell.Row, Range("SaveConcept").Column).Value = ComboBoxConcept.ListIndex
Cells(ActiveCell.Row, Range("SaveDetail").Column).Value = ComboBoxDetail.ListIndex
Cells(ActiveCell.Row, Range("SaveLandscape").Column).Value = ComboBoxLandscape.ListIndex
Cells(ActiveCell.Row, Range("SaveLighting").Column).Value = ComboBoxLighting.ListIndex
Cells(ActiveCell.Row, Range("SaveRSA").Column).Value = ComboBoxRSA.ListIndex
Cells(ActiveCell.Row, Range("SaveSurvey").Column).Value = ComboBoxSurvey.ListIndex
Cells(ActiveCell.Row, Range("SaveGeoTech").Column).Value = ComboBoxGeotech.ListIndex
Cells(ActiveCell.Row, Range("SaveService").Column).Value = ComboBoxService.ListIndex
Cells(ActiveCell.Row, Range("SaveVegetation").Column).Value = ComboBoxVegetation.ListIndex
Cells(ActiveCell.Row, Range("SaveOffset").Column).Value = ComboBoxOffset.ListIndex
Cells(ActiveCell.Row, Range("SaveCHMP").Column).Value = ComboBoxCHMP.ListIndex
Cells(ActiveCell.Row, Range("SavePlanning").Column).Value = ComboBoxPlanning.ListIndex
Cells(ActiveCell.Row, Range("SaveBuilding").Column).Value = ComboBoxBuilding.ListIndex
Cells(ActiveCell.Row, Range("SaveXDetail").Column).Value = CheckBoxDetail.Value
Cells(ActiveCell.Row, Range("SaveXLandscape").Column).Value = CheckBoxLandscape.Value
Cells(ActiveCell.Row, Range("SaveXSurvey").Column).Value = CheckBoxSurvey.Value
'hides the last row
Range("LRow").EntireRow.Hidden = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Unload Me
If Projects.EnableMisc.Value = True Then
 MiscInsert.Show
Else
End If
End Sub
Jamal
35.2k13 gold badges134 silver badges238 bronze badges
asked Nov 28, 2016 at 3:07
\$\endgroup\$

2 Answers 2

2
\$\begingroup\$

It looks like using ListIndex could cut down your code considerably, however this may reduce the readability of your code, and you may need to reorder the options in the ComboBox or where the data is saved.


Select Case Me.ComboBoxOffset.Value
 Case "Large"
 Cells(ActiveCell.Row, Range(RangeName).Column).Value = "ü"
 Case "Medium"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 1).Value = "ü"
 Case "Small"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 2).Value = "ü"
 Case Else
End Select

By using ListIndex you could cut this function down to:

Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, ComboBoxOffset.ListIndex).Value = "ü"

ListIndex returns the index number of the option selected, in this case:

0 - Large

1 - Medium

2 - Small

(This assumes that the options are ordered in this way in your ComboBox)

Note how the index begins at 0 like Arrays, this is useful in your case as your first option "Large" requires no Offset. By using ListIndex within Offset the option "Large" is effectively Offset(0, 0), in other words no offset is made, and so you don't need to write an If statement to handle the first option exclusively.


Select Case Me.ComboBoxConcept.Value
 Case "Review"
 Cells(ActiveCell.Row, Range(RangeName).Column).Value = "ü"
 Case "Large"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 1).Value = "ü"
 Case "Medium"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 2).Value = "ü"
 Case "Small"
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, 3).Value = "ü"
 Case Else
End Select

So how could we use ListIndex to reduce this one? Well...

Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, ComboBoxConcept.ListIndex).Value = "ü"

It's the same one line of code, only the name of the ComboBox has been changed, pretty simple stuff.


Potential issue

Something to note with ListIndex is that if no option has been selected in the ComboBox, ListIndex will return a value of -1. This is an issue in your case as the offset will be (0, -1), meaning it will write in a column it shouldn't.

The easiest way to get around this is to check that an option has been selected before changing any cell values:

If ComboBoxOffset.ListIndex <> -1 then
 Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, ComboBoxOffset.ListIndex).Value = "ü"
End If
answered Nov 29, 2016 at 13:11
\$\endgroup\$
1
\$\begingroup\$

I'd redesign the code to make it more clear and maintainable:

1. use dictionary to store selection options and corresponding values

 With ConceptDictionary
 .Add "Review", 0
 .Add "Large", 1
 .Add "Medium", 2
 .Add "Small", 3
 End With

This way you can easily compose your range reference:

Cells(ActiveCell.Row, Range(RangeName).Column).Offset(0, ConceptDictionary.Item(Me.ComboBoxConcept.Value)).Value = "ü"

This might seem complicated, but it has it's advantages:

  • you can keep all the constant values together, and review them if necessary
  • no need to adapt order in combobox to order in sheet

2. Keep related data together

Create a custom type where you can collect related ranges and objects:

Public Type RelatedData
 DataRange As Range
 TitleControl As Object
 SelectionControl As Object
 SelectionOptions As Dictionary
End Type
Public DataToProcess() As RelatedData

This way you can create a sub which loads the information:

Sub LoadData()
 ReDim DataToProcess(1 To 10) ' adapt to the size of your data
 With DataToProcess(1)
 Set .DataRange = Range("ProjConcept")
 Set .TitleControl = Me.TextBoxConcept.Value
 Set .SelectionOptions = New Dictionary
 With .SelectionOptions
 .Add "Review", 0
 .Add "Large", 1
 .Add "Medium", 2
 .Add "Small", 3
 End With
 End With
 With DataToProcess(2)
 ' repeat for all data...
 End With
End Sub

So you've everything together in a condensed way, just need to refresh if anything is changed..

3. loop through your custom type

Sub FillData()
 Dim i As Integer
 For i = LBound(DataToProcess) To UBound(DataToProcess)
 With DataToProcess(i)
 Cells(ActiveCell.Row, .DataRange.Column).Offset(0, _
 4).Value = .TitleControl.Value
 Cells(ActiveCell.Row, .DataRange.Column).Offset(0, _
 .SelectionOptions.Item(.SelectionControl.Value)).Value = "ü"
 End With
 Next i
End Sub

And really a small sub doing the job.

answered Nov 29, 2016 at 14:10
\$\endgroup\$
1
  • \$\begingroup\$ I don't have much experience with dictionaries, is it possible to populate a ComBobox using a dictionary? I wasn't able to find any examples online but would something like ComboboxConcept.add ConceptDictionary(i) and then loop LBound to UBound work, or is it possible to add the whole dictionary at once? and would it be possible to set .selectionoptions = ConceptDictionary? I think that using the same dictionary to assign values to everything would increase maintainability and reduce errors, thoughts? \$\endgroup\$ Commented Nov 30, 2016 at 1:29

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.