I have 2 small lists of combo boxes. The first list is labled Type(1-5). The second list is labled Products(1-5). I want to populate each PRODUCT box pending on the selection made in the corresponding TYPE box. I am currently doing the following...
Private Sub Type1_Change()
NavComboPropChange
End Sub
Sub NavComboPropChange()
If BaseActiveControl.Name = "AVM" Then
= Worksheets("Setup").Range("AVM").Value
ElseIf BaseActiveControl.Name = "Appraisal" Then
= Worksheets("Setup").Range("APPRAISAL").Value
Else
= Worksheets("Setup").Range("TITLES").Value
End If
End Sub
BaseActiveControl.name grabs the root control element currently selected. Before the equal sign in the IF, ElseIf, Else sequence would be the product name and the corresponding value.
To restate my question though, I want to know how I can grab the numeric part of the control name to use in conjunction with the product box name.
I found the solution using this route.
Sub NavComboPropChange()
Dim myString As String
myString = Right(BaseActiveControl.Name, Len(BaseActiveControl.Name) - 4)
If BaseActiveControl.Value = "AVM" Then
Controls("Products" & myString).List = Worksheets("Setup").Range("AVM").Value
ElseIf BaseActiveControl.Value = "Appraisal" Then
Controls("Products" & myString).List = Worksheets("Setup").Range("APPRAISAL").Value
Else
Controls("Products" & myString).List = Worksheets("Setup").Range("TITLES").Value
End If
End Sub
Related
I am having trouble finding a way if the combobox value is selected to add to the listbox but if the combobox value is already display in the listbox then a msgbox appears saying "this value is already in the listbox". I am trying to use an if statement then a for loop. For example, if I pick the letter d and then add it to the listbox it will but if I pick d again from the combo box then a message will acquire saying this value is already in the listbox and will not add the letter d again.
I believe I should use an if statement, but I don't know have to formulate it
Private Sub cmdplayer_Click()
Dim ratio As Double
Dim formatratio As String
Dim name As String
Me.listbox.ColumnCount = 2
If cmbComboBox.Value = "" Then
MsgBox "Please Select a Player"
ElseIf cmbComboBox.Value = Me.listbox.List Then
MsgBox cmbComboBox.Value & " has already been added to your team"
Else
name = Me.cmbComboBox.Column(0)
Me.listbox.AddItem name
ratio = Me.cmbComboBox.Column(3)
formatratio = FormatNumber(ratio, 1)
Me.listbox.List(listbox.ListCount - 1, 1) = formatratio
End If
End Sub
try this:
Private Sub cmbComboBox_Change()
Dim duplicate As Boolean
Dim person As String, lName As String
person = Me.cmbComboBox.Column(0)
duplicate = False
For i = 0 To Me.listbox.ListCount - 1
lName = Me.listbox.List(i)
If lName = person Then
duplicate = True
MsgBox "This person is already part of the team."
Exit For
End If
Next i
If Not duplicate Then
Me.listbox.AddItem person
End If
End Sub
I have a UserForm which lets the user input a count of product defects into a textbox. This is done as part of monthly reporting, so I have option buttons to select the Month (12 options). There are also option buttons for selecting Product Type. The code basically evaluates what options are selected and copies the textbox values (defect counts) into specific cells in another spreadsheet (for reporting purposes). Not all TextBoxes are required to have values entered by the User.
You can check out a screenshot of the UserForm https://imgur.com/a/6QefjCp.
As you can see from the code, I'm using a bunch of IF statements to perform the decision making - I would like to reduce the length of this code, but I don't know where to start.
I have never really used VBA prior to this, so haven't really attempted a solution. In its current state, the code works flawlessly. Just looking to reduce and clean-up.
Private Sub OKButton_Click() 'This is the button the user clicks to finalize
'the data entry
'Calling the Product type modules
Call Product1Module
Call Product2Module
Call Product3Module
End Sub
Sub Product1Module() 'All product modules will look almost exactly like this
'except the cell ranges will be different
If UserForm.Product1Button.Value = True Then 'Checking for Product1 Option button
If UserForm.JANButton.Value = True Then
'Record value to textbox if JAN is selected
Sheets("Sheet1").Range("B1107").Value = UserForm.TextBox1.Value
Sheets("Sheet1").Range("B1115").Value = UserForm.TextBox2.Value
Sheets("Sheet1").Range("B1108").Value = UserForm.TextBox3.Value
Sheets("Sheet1").Range("B1116").Value = UserForm.TextBox4.Value
Sheets("Sheet1").Range("B1109").Value = UserForm.TextBox5.Value
Sheets("Sheet1").Range("B1117").Value = UserForm.TextBox6.Value
Sheets("Sheet1").Range("B1111").Value = UserForm.TextBox7.Value
ElseIf UserForm.FEBButton.Value = True Then
Sheets("Sheet1").Range("C1107").Value = UserForm.TextBox1.Value
Sheets("Sheet1").Range("C1115").Value = UserForm.TextBox2.Value
Sheets("Sheet1").Range("C1108").Value = UserForm.TextBox3.Value
Sheets("Sheet1").Range("C1116").Value = UserForm.TextBox4.Value
Sheets("Sheet1").Range("C1109").Value = UserForm.TextBox5.Value
Sheets("Sheet1").Range("C1117").Value = UserForm.TextBox6.Value
Sheets("Sheet1").Range("C1111").Value = UserForm.TextBox7.Value
...
End If
End If
End Sub
Give each of your option buttons a Tag property value - e.g. make JANButton.Tag be "B", then make FeBButton.Tag be "C", etc.
Then you can do this:
Dim targetColumn As String
Select Case True
Case UserForm.JANButton
targetColumn = UserForm.JANButton.Tag
Case UserForm.FEBButton
targetColumn = UserForm.FEBButton.Tag
'...
End Select
With Worksheets("Sheet1") '<~ which workbook is that in? whatever is active?
.Range(targetColumn & "1107").Value = UserForm.TextBox1.Value
.Range(targetColumn & "1115").Value = UserForm.TextBox2.Value
'...
End With
It is very simple but yet I can't figure it out. Maybe because it cannot be done? Regardless here we go:
I would like to use a combobox that will, when selected, input cells with text values, functions and reference to external cells.
First line of the options would be to have the name populated.
Second line is a formula that would change from course to course.
Third line would provide a cell with a reference to another cell's content from another file. So if multiple course file are used I can have one master file that if I change the content of a cell the change will reflect on all the course file cells that are referring to it once updated.
This is in crude code form what I would like it to perform.
Private Sub ComboBox1_Change()
If Me.ComboBox1.Value = "ITCourse" Then
Worksheets("PARADE STATE").Range("I1").Value = "ITCourse"
Worksheets("Data Base").Range("C1").Value = IF(V9>70,"Prep Week",IF(V9>65,"Week 1",IF(V9>60,"Week 2",IF(V9>55,"Week 3",IF(V9>50,"Week 4",IF(V9>45,"Week 5",IF(V9>40,"Week 6",IF(V9>35,"Week 7",IF(V9>30,"Week 8",IF(V9>25,"Week 9",IF(V9>20,"Week 10",IF(V9>15,"Week 11",IF(V9>10,"Week 12",IF(V9>5,"Week 13",IF(V9>0,"Week 14")))))))))))))))
Worksheets("Week 1").Range("B2").Value = 'N:\ITcourse\00 - Data Base\[ITcourse.xlsx]Sheet'!$A$3
End If
If Me.ComboBox1.Value = "HRCourse" Then
Worksheets("PARADE STATE").Range("I1").Value = "HRCourse"
Worksheets("Data Base").Range("C1").Value = IF(V9>40,"Prep Week",IF(V9>35,"Week 1",IF(V9>30,"Week 2",IF(V9>25,"Week 3",IF(V9>20,"Week 4",IF(V9>15,"Week 5",IF(V9>10,"Week 6",IF(V9>5,"Week 7",IF(V9>5,"Week 8")))))))))
Worksheets("Week 1").Range("B2").Value = 'N:\ITcourse\00 - Data Base\[HRcourse.xlsx]Sheet'!$A$3
End If
End Sub
Thank you!
You need a function that returns the number of weeks for any given course name. This function should use a Dictionary to store the information, and the dictionary may be loaded from a dedicated worksheet.
Function WeeksPerCourse(courseName As String) As Long
Static dict As Scripting.Dictionary
If dict Is Nothing Then
' Fill the dictionary here. Note that it is better
' to load the values from a dedicated, hidden worksheet
Set dict = CreateObject("Scripting.Dictionary")
dict("ITCourse") = 14
dict("HRCourse") = 8
' Etc...
End If
WeeksPerCourse = dict(courseName)
End Function
With this function available, your procedure can be simplified like follows:
Private Sub ComboBox1_Change()
Dim course As Sting: course = Trim(ComboBox1.value)
Worksheets("PARADE STATE").Range("I1").value = course
'Dim nWeek As Long
'nWeek = WeeksPerCourse(course) - Worksheets("PARADE STATE").Range("V9").value / 5
'Worksheets("Data Base").Range("C1").value = IIf(nWeek < 1, "Prep Week", "Week " & nWeek)
Worksheets("Data Base").Range("C1").Formula = "= ""Week "" & INT((WeeksPerCourse('PARADE STATE'!I1) - 'PARADE STATE'!V9)/5)"
Worksheets("Week 1").Range("B2").Formula= "='N:\ITcourse\00 - Data Base\[" & course & ".xlsx]Sheet'!$A$3"
End Sub
I have a listbox in a Diagram, when calling the function "drawDiagram" I want to get the selected Items of the listbox. Here is my code to do that:
Function DrawDiagram()
Dim x As Integer
Dim diaLst As ListBox
Set diaLst = ActiveSheet.ListBoxes("DiaList")
' find selected trends in List Box
For x = 0 To diaLst.ListCount - 1
If diaLst.Selected(x) = True Then
MsgBox x
End If
Next x
End Function
diaLst.ListCount correctly returns the number of Items in the list. But diaLst.Selected(x) does not work at all.
The Error message is:
German: "Die Selected-Eigenschaft des ListBox-Objektes kann nicht zugeordent werden"
English: "The Selected Property of the ListBox Object cannot be assigned" (or similar)
Does anyone know, what I did wrong?
thanks
natasia
By the way, this is the code I used to generate the list box in a chart sheet, in a separate function. At the moment when a button is clicked, the DrawDiagram function is called. The aim of the "DrawDiagram" function is to plot the selected items of the listbox in the diagram.
Set diaLst = ActiveSheet.ListBoxes.Add(ActiveChart.ChartArea.Width - 110, 5, 105, 150)
With diaLst
.Name = "DiaList"
.PrintObject = False
.MultiSelect = xlSimple
i = 2
While wTD.Cells(rowVarNames, i) <> ""
.AddItem wTD.Cells(rowVarNames, i)
i = i + 1
Wend
.Selected(3) = True
End With
first off, you must be dealing with a "Form" control (not an "ActiveX" one) otherwise you couldn't get it via .ListBoxes property of Worksheet class
I tested it in my environment (W7-Pro and Excel 2013) and found that (quite strangely to me) the Selected() property array is 1-based.
This remained even with Option Base 0 at the beginning of the module
Make sure Microsoft Forms 2.0 Object Library reference is added to your project
Function DrawDiagram()
Dim x As Long
Dim diaLst As MSForms.ListBox
Set diaLst = ActiveSheet.ListBoxes("DiaList")
' find selected trends in List Box
For x = 1 To diaLst.ListCount
If diaLst.Selected(x) = True Then
MsgBox x
End If
Next x
End Function
use Sheets("Sheet1").Shapes("List Box 1").OLEFormat.Object instead
I stumbled upon the same problem. The solution turned out to be simple, just had to tweak the code a litte bit and play around with the ListBox properites:
Function GetSelectedRowsFromListBox(lstbox As ListBox) As Collection
Create the collection
Dim coll As New Collection
Dim lst_cnt As Variant
lst_cnt = lstbox.ListCount
Dim arr_selectedVal As Variant
arr_selectedVal = lstbox.Selected
' Read through each item in the listbox
Dim i As Long
For i = 1 To lstbox.ListCount
' Check if item at position i is selected
If arr_selectedVal(i) Then
coll.Add i
End If
Next i
Set GetSelectedRowsFromListBox = coll
End Function
.Selected property returns a 1-based array with True/False values coresponding to rows in your multiple choice Form Control ListBox.
From that you can get the list of each value.
This solution is an expanded version of what is mentioned here, however this also complies with Form Control ListBox, no just ActiveX ListBox (which are 2 same but different things ;) ):
https://excelmacromastery.com/vba-listbox/
Hope that helps in the future!
i have a userform with 2 textboxes, 2 labels and a log in button.
On my excel sheet i have a sort of database with id, name, pin and balance.
the problem is whenever i click the login button my ID textbox resets its value to 0, but my pin textbox works fine!
i will paste my complete code:
Dim ID As Integer
Dim PIN As Integer
Dim PINField As String
Dim Balance As Double
Dim Attempts As Integer
Dim BalanceField As String
Private Sub btnLogin_Click()
txtID.Text = ID
Call SetId
Call Authenticate
End Sub
Sub Authenticate()
If txtPin.Text = PIN Then
Call Welcome
ElseIf Attempts > 3 Then
Call Bye
Else
lblWelcome.Caption = "Wrong Pin"
lblWelcome.ForeColor = RGB(255, 0, 0)
Attempts = Attempts + 1
End If
End Sub
Sub SetId()
PINField = "C" & Str(ID)
PINField = Replace(PINField, " ", "")
MsgBox (PINField)
BalanceField = "D" & Str(ID)
BalanceField = Replace(BalanceField, " ", "")
MsgBox (BalanceField)
End Sub
Sub Welcome()
MsgBox ("Login Successful. Welcome")
End Sub
Sub Bye()
MsgBox ("Max Pin Attempts reached. Contact Your Bank")
Unload frmLogin
End Sub
The reason it does this is because you are using a variable which has no value. Since it is an Integer it returns 0.
I'm guessing you probably actually want to have ID = txtID.Text - that is, take the value of the txtID textbox and store the value in the ID variable.
This will probably error though because the Text property of a textbox is a String. You will need to use ID = CInt(txtID.Text). You should also do some checking to make sure that txtID.Text evaluates to an Integer before assignment.
Please make sure there's no reset for the txtID anywhere in the code that you have not shown here. Looking at your code, it doesn't say anything how you are setting values to either ID or PIN... You said it's working fine for PIN, so it makes me very curious...
It could be the case Nick pointed out given this is a Form with textboxes allowing people to enter ID and PIN.. And then you are comparing it against PIN. But what are you comparing against? As you said you have a database kind of a structure in the sheet. You need to assing ID and PIN using it.
Here is the visualization I have for your Sheet, which is my best blind guess:
User needs to enter a value via the Form into txtID. That number is infact the cell number for column C which contains the relevant PIN. Then you compare that PIN with the txtPIN value. Next return the balance from column D based on that PIN.
Try this:
Private Sub btnLogin_Click()
If txtID.Text <> "" Or txtID.value > 0 or txtPIN.Text <> "" Then
ID = CInt(txtID.Text)
Call SetID
Call Authentication
Else
MsgBox "ID and PIN" can't be empty!"
End If
End Sub
Sub Authenticate()
If CInt(txtPin.Text) = PIN Then '-- here
Call Welcome
'-- idealy Blance can be shown at this point...
ElseIf Attempts > 3 Then
Call Bye
Else
lblWelcome.Caption = "Wrong Pin"
lblWelcome.ForeColor = RGB(255, 0, 0)
Attempts = Attempts + 1
End If
End Sub
Sub SetId()
PIN = CInt(Trim(Sheets(1).Range("C" & ID).value))
'-- NOT sure why you are showing this PIN here since you want to authenticate...?
MsgBox PIN
BalanceField = Sheets(1).Range("D" & ID).value
BalanceField = Trim(BalanceField) '--here
'-- doesn't make sense to show Balance before authentication...
MsgBox BalanceField
End Sub
Trim is clearner and faster than Replace..