How to Create a Simple Userform with Checkboxes in VBA - vba

I am extremely new to VBA and am trying to create a spreadsheet that uses a checkbox userform to populate a table in a spreadsheet. I have been able to get the table to populate, but if a box is accidentally checked and is unchecked, the table remains populated. How do I get the table to go back to being blank after a box is unchecked and what is an efficient way to code the 33 checkboxes to populate the 33 spaces in the spreadsheet. Please see the images attached to aid in my description.
Thanks,
Userform Image
Spreadsheet Image

Setting the CheckBox ControlSource Property to a range address will link it to the range. If the range isn't qualified A1 the Checkbox will link to the Worksheet that is the ActiveSheet when the Userform Opens. To qualify the address add the Range's parent Worksheet's Name in single quotes followed by a exclamation mark and finally the ranges relative address 'Check List'!A1.
Initially, the Checkbox will be grayed out indicating that the linked cell is empty. When you check and uncheck it the linkedcell value will toggle between True and False.
Demo Userform Code
Private Sub UserForm_Initialize()
Dim Left As Single, Top As Single
Dim cell As Range, row As Range, check As MSForms.CheckBox
Top = 25
Left = 25
With Worksheets("Check List")
For Each row In .Range("A2:K4").Rows
For Each cell In row.Cells
Set check = Me.Controls.Add("Forms.CheckBox.1")
With check
.ControlSource = "'" & cell.Parent.Name & "'!" & cell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
.Left = Left
.Top = Top
Left = Left + 12
End With
Next
Left = 25
Top = Top + check.Height + 2
Next
End With
End Sub

Related

Assign macro to a cell corresponding to the row of automatically generated buttons

I've managed to create a form where the user can expand the fields of a pivot table and, once they've completely expanded a field/branch, a button will appear in column E and that pivot field data is concatenated in column J (there are some hidden columns).
What I want is for the user to click an auto-generating button in column E which exports the corresponding data in column J to a list, somewhere on the workbook.
My code below automatically generates the buttons for fully expanded fields, but I have no idea how to write the code to link each button to the corresponding cell in column J - this is probably not very difficult but any help would be appreciated.
Sub buttonGenerator()
Dim btn As Button
Application.ScreenUpdating = False
ActiveSheet.Buttons.Delete
Dim t As Range
Dim size As Integer
size = ActiveSheet.PivotTables("Pivottable1").TableRange2.Rows.Count
For i = 2 To size Step 1
If Not IsEmpty(ActiveSheet.Range(Cells(i, 4), Cells(i, 4))) Then
Set t = ActiveSheet.Range(Cells(i, 5), Cells(i, 5))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "btnS"
.Caption = "Add to summary" '& i
.Name = "Btn" & i
End With
End If
Next i
Application.ScreenUpdating = False
End Sub
Sub buttonAppCaller()
MsgBox Application.Caller
End Sub
So here is my code .. it is throwing Runtime error 1004 "Unable to get the Buttons property of the worksheet class". Not sure what I've done wrong but I need to get the data from the cell next to the button to copy over to the bottom of a list in sheet 2 when that particular button is clicked. Please help!
Sub btnS()
Dim dest As Range
Dim origin As Range
origin = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Offset(0, 1) 'input data from cell next to button click
dest = Worksheets("Form Output").Range("A1") 'output data to list in sheet 2 - "Form output"
Set dest = origin
End Sub
Don't use Integer for row counts as you did for size. Excel has more rows than Integer can handle. It is recommended always to use Long instead of Integer in VBA there is no benefit in Integer at all.
The procedure every button invokes is called btnS as you defined in .OnAction = "btnS". Therefore you need a Sub with that name in a Module.
You can use Buttons(Application.Caller).TopLeftCell to get the cell under a button and from that cell you can determine the row or column.
Public Sub btnS() 'sub name must match `.OnAction` name
MsgBox ActiveSheet.Buttons(Application.Caller).TopLeftCell.Row
End Sub
Instead of using ActiveSheet I recommend to use a specific worksheet like Worksheets("your-sheet-name") if you plan to use it on a specific sheet only. ActiveSheet can easily change and should be avoided where possible.

Populating header of Listbox from column header

1. Background & purpose
I'm creating a userform to display data from the Excel sheet("DATA") with table ("Tab1") of multi-columns like below picture.
In my form ("TaskMngUserForm"), after clicking on "Task List" button, all data from Tab1 will be displayed on Listbox1 as follows:
Column header in Tab1 will be displayed on Listbox1 as Header.
Data from 2nd row to end in Tab1 will be diplay on Listbox1 corresponding to each columns.
Also I'm adding an event for action "Listbox1_Click()" that returns "Data" sheet row corresponding to the selected Index, from the second column of the selected ListBox1 row.
UserForm and Listbox
2. Code
'4. Event for "Tasks List" button
Private Sub Button_TaskList_Click()
ListBox1.ColumnWidths = "20;100;80;100;60;100;80;80;80;200;200;200"
ListBox1.ColumnCount = 12
With ListBox1
'.ColumnHeads = True
.List = Sheets("DATA").Range("B2").CurrentRegion.Value
.RemoveItem (0)
.ColumnCount = Sheets("DATA").Cells(2, 2).CurrentRegion.Columns.Count
End With
Application.ScreenUpdating = True
Label25.Caption = "Total Tasks: " & (Worksheets("DATA").UsedRange.Rows.Count - 1)
End Sub
'6. Event for "Click Listbox" Action
Private Sub ListBox1_Click()
Dim strAddress As String
Dim dataSht As Worksheet
With Me
If .ListBox1.ListIndex <> -1 Then
Set dataSht = Sheets("DATA")
If IsNull(Me.ListBox1.Value) Then
Call MsgBox("You are selecting on blank row item" & vbNewLine & "Be careful!", vbInformation, "Notification")
Button_TaskList_Click
Else
strAddress = GetIndexRow(.ListBox1.List(.ListBox1.ListIndex, 0), dataSht.Columns("A"))
'<~~ GetIndexRow returns "Data" sheet row corresponding to the selected Index, which is got from the 2nd column of the selected ListBox row
TaskMngUserForm.txtIndex.Value = dataSht.Range("A" & strAddress).Value
TaskMngUserForm.cmbSource.Value = dataSht.Range("B" & strAddress).Value
TaskMngUserForm.cmbType.Value = dataSht.Range("C" & strAddress).Value
TaskMngUserForm.cmbCategory.Value = dataSht.Range("D" & strAddress).Value
TaskMngUserForm.cmbPriority.Value = dataSht.Range("E" & strAddress).Value
TaskMngUserForm.cmbTaskOwner.Value = dataSht.Range("F" & strAddress).Value
TaskMngUserForm.cmbStatus.Value = dataSht.Range("G" & strAddress).Value
TaskMngUserForm.txtOpenDate.Value = dataSht.Range("H" & strAddress).Value
TaskMngUserForm.txtCloseDate.Value = dataSht.Range("I" & strAddress).Value
TaskMngUserForm.txtSubject.Value = dataSht.Range("J" & strAddress).Value
TaskMngUserForm.txtDescription.Value = dataSht.Range("K" & strAddress).Value
TaskMngUserForm.txtSolution.Value = dataSht.Range("L" & strAddress).Value
End If
' TaskMngUserForm.Show
End If
End With
Application.ScreenUpdating = True
Label25.Caption = "Check in Task.No: " & txtIndex.Text
End Sub
3. Problem
I can load data from Tab1 to Listbox1 but I cannot populate column header from Tab1 to Header in Listbox1.
I recently coded a UserForm to include headers and I can answer this for you.
There is only 1 way to populate the headers on a ListBox and that is when you use the ListBox1.RowSource property. In the RowSource property you must assign a Range, this is one example:
UserForm1.ListBox1.RowSource = "Sheet1!A2:H20"
This will populate the data from A2 to H20 on ListBox1 and if the ListBox1 ColumnHeaders property is set to True then anything on Sheet1!A1:H1 will become the headers. This is the only way.
The reason that many users will tell you to just add text labels on top of the ListBox to make it easier is because when you do your list using RowSource, you must always find out what is the last Row used on your Range before you assign the Range to avoid Empty lines on your ListBox. What this means is that if you have 20 rows of data and you assign a range that contains 50 rows, the listbox will populate 50 rows, the last 30 will be empty.
Don't need Code or Formulas. Include the headers as part of the define factor for the data page, mine is named RecordsGoodCharacters, the name of the worksheet.
Highlight the Sheet Cells & Columns required. Include the headers as part of the define factor. Mine is RecordsLanguages for this Worksheet, which is the worksheets name.
Type in the name top left, to DEFINE the highlighted areas and then press ENTER on the keyboard, if you don’t use the keyboard, it won’t work.
Once defined, open your VBA Userform
Click on the ListBox
In it properties on the left of the display, in the RowSource area, Type the defined name used.
The list box will show the list including the headers.

VBA Form - Vlookup cell and assign value to that cell

Encountering an issue in a VBA regarding vlookup function.
I have 2 comboboxes and 6 Textboxs for user input.
I want to use a vlookup (or index,Match(),Match()) to look up a cell in a data table and assign the values from the textboxes to these cells.
When I run the code for what I believe should work, it is returning object errors.
Private Sub CommandButton2_Click()
Dim MonthlyTable As Range
Set MonthlyTable = Sheets("DATA Monthly").Range("A6:AE400")
Dim ColumnRef As Range
Set ColumnRef = Sheets("Drivers").Range("N11")
' Assign CB2 value to M11 cell reference so it can be converted to a column ref in N11.
Sheets("Drivers").Range("M11").Value = ComboBox2.Value
Dim CB1Value As String
CB1Value = "Joiners" & ComboBox1.Value
Dim CB2Value As String
CB2Value = ComboBox2.Value
MsgBox CB1Value & " " & CB2Value
Dim tb1value As Range
tb1value = Application.WorksheetFunction.VLookup(CB1Value, MonthlyTable, ColumnRef, False)
tb1value.Value = TextBox1.Value
Unload Me
End Sub
I am at a loss for what to do here as I feel like it should be this simple!
Thanks in advance.
Edit. Further digging indicates that you cannot select a cell you are vlookup'ing as this commands only returns a value it does not actually select the cell for my intents and purposes.
not really clear to me you actual aim, but just following up your desire as stated by:
I want to use a vlookup (or index,Match(),Match()) to look up a cell
in a data table and assign the values from the textboxes to these
cells
you may want to adopt the following technique:
Dim tb1value As Variant '<--| a variant can be assigned the result of Application.Match method and store an error to be properly cheeked for
tb1value = Application.Match(CB1Value, MonthlyTable.Column(1), 0) '<--| try finding an exact match for 'CB1Value' in the first column of your data range
If Not IsError(tblvalue) Then MonthlyTable(tb1value, columnRef.Value).Value = TextBox1.Value '<--| if successful then write 'TextBox1' value in data range cell in the same row of the found match and with `columnRef` range value as its column index
Excel uses worksheet functions to manipulate data, VBA has different tools, and when you find yourself setting cell values on a sheet via VBA so that some worksheet function can refer to them it is time to look for a true VBA solution. I suggest the following which, by the way, you might consider running on the Change event of Cbx2 instead of a command button.
Private Sub Solution_Click()
' 24 Mar 2017
Dim MonthlyTable As Range
Dim Rng As Range
Dim Lookup As String
Dim Done As Boolean
Set MonthlyTable = Sheets("DATA Monthly").Range("A2:AE400")
' take the lookup value from Cbx1
Lookup = ComboBox1.Value
Set Rng = MonthlyTable.Find(Lookup)
If Rng Is Nothing Then
MsgBox Chr(34) & Lookup & """ wasn't found.", vbInformation, "Invalid search"
Else
With ComboBox2
If .ListIndex < 0 Then
MsgBox "Please select a data type.", vbExclamation, "Missing specification"
Else
TextBox1.Value = MonthlyTable.Cells(Rng.Row, .ListIndex + 1)
Done = True
End If
End With
End If
If Done Then Unload Me
End Sub
There are two points that need explanation. First, the form doesn't close after a rejected entry. You would have to add a Cancel button to avoid an unwanted loop where the user can't leave the form until he enters something correct. Note that Done is set to True only when the search criterion was found And a value was returned, and the form isn't closed until Done = True.
Second, observe the use of the ListIndex property of Cbx2. All the items in that Cbx's dropdown are numbered from 0 and up. The ListIndex property tells which item was selected. It is -1 when no selection was made. If you list the captions of your worksheet columns in the dropdown (you might do this automatically when you initialise the form) there will be a direct relationship between the caption selected by the user (such as "Joiners") and the ListIndex. The first column of MonthlyTable will have the ListIndex 0. So you can convert the ListIndex into a column of MonthlyTable by adding 1.
I think it is better to use "find" in excell vba to select a cell instead of using vlookup or other methods.

Adding combo box across multiple cells

I need to add combo box(ActiveX Control) or Data Validation as drop down list.
I have a range of 15 values like, high, low, medium,etc...
Have created named range called "priorityvalue".
I can create a dropdown list using combo box by adding named range under ListFillRange in the properties or data validation list by giving named range.
But my concern, I need to dropdown list for 58cells with same values mentioned above. Its tedious job to create combo box for all cells. Please suggest me better option here.
Data validation list serves the purpose. However, it makes user to scroll through dropdown list on each cell unlike combo box it has no input box..
Please suggest
Paste the below code in 'ThisWokbook'
Private Sub Workbook_Open()
Dim oItem As Object
For Each oItem In Worksheets(1).OLEObjects
If TypeName(oItem.Object) = "ComboBox" Then
If Len(oItem.Object.Value) > 0 Then
oItem.Object.Value = ""
End If
End If
Next
Set oItem = Nothing
End Sub
NOTE: There are caveats to this. Above code will reset all comboboxes in your worksheet (also, I've set the worksheet to the first worksheet in the workbook, you might want to make that dynamic). If you don't want it to reset all comboboxes and only do the ones you added via the function, you can use the name format to filter the ones you want to clear
Hope this helps
Try this:
Sub AddComboBoxToColumns(ByVal oRange As Excel.Range)
Dim oOLE As OLEObject
Dim oCell As Object
' Loop through all the cells in the range
For Each oCell In oRange.Cells
' Add ComboBox in each cell
With oCell
Set oOLE = .Parent.OLEObjects.Add("Forms.combobox.1")
oOLE.Top = .Top
oOLE.Left = .Left
oOLE.Width = .Width
oOLE.Height = .Height
oOLE.Name = "ComboBox" & .Address(False, False)
oOLE.Object.List = Array("Test1", "Test2")
End With
Next
Set oOLE = Nothing
End Sub
NOTE: Call the above function with the range of cells you want to add ComboBox to. You will have to change the Array to use the values you want (you can type them in there or give the range where your existing values are)

Populating a dropdown box with already-existing options in VBA?

I'm making an add records form for a spreadsheet of mine, and let's say that I want one of the controls to be a dropdown that is populated by unique entries under a certain column "type". However, I want to also make it such that the dropbox always has a initial option to "add new type" and upon such selection, it becomes a regular text box. How would I do this in VBA?
You cannot change a control type at run time. The easiest thing to do is create a combo box and a text box. Set the text box visibility to false. Then in the onchange event of the combo box your code will unhide the text box and hide the combo box. You will also need a save button so that when it is clicked it will add the option to the drop down, clear the text box, hide the text box, hide the button and unhide the drop down.
Okay, so here's my idea of how to tackle this.
Create 2 hidden elements (Visibility = False), one a TextBox and one a CommandButton.
Populate your ComboBox with the values from the sheet under column "type"
Add one more entry AddItem with wording such as "Add new item..."
When the user selects "Add new item...", change the Visibility of the TextBox & CommandButtons to True
When the user clicks the CommandButton, add the phrase to the column and add a new element to the ComboBox
I have created a mockup UserForm and code that does a little more than just this; it also styles the user entry to sentence case (consistency purposes) and checks to make sure the value isn't already in the column.
Excel Sheet with "type" column
UserForm with name labels
UserForm Code
Private Sub bAdd_Click()
Dim str As String
Dim rng As Range
Dim ro As Integer
'Makes sure there is an entry, adds it to the Sheet and then updates the dropdown
If Len(Me.tbNew) > 0 Then
'Converts user entry to "Sentance Case" for better readability
str = StrConv(Me.tbNew, vbProperCase)
'Finds out if the entry already exists
Set rng = Sheets(1).Range(Sheets(1).Cells(2, 1), Sheets(1).Cells(Sheets(1).Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row, 1))
On Error Resume Next
Err.Number = 0
'Searches for duplicate; if found, then ListIndex of cbColor is modified without inserting new value (prevents duplicates)
ro = rng.Find(str, LookIn:=xlValues, LookAt:=xlWhole).Row
Debug.Print Err.Number
'Ensures a user doesn't add the same value twice
If Err.Number > 0 Then
Sheets(1).Cells(Sheets(1).Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row + 1, 1) = str
Me.cbColor.AddItem StrConv(Me.tbNew, vbProperCase), Me.cbColor.ListCount - 1
Me.cbColor.ListIndex = Me.cbColor.ListCount - 2
Else
Me.cbColor.ListIndex = ro - 2
End If
'Resets and hides user form entries
Me.tbNew = vbNullString
Me.tbNew.Visible = False
Me.bAdd.Visible = False
End If
End Sub
Private Sub bClose_Click()
Unload Me
End Sub
Private Sub cbColor_Change()
'Visibility is toggled based on if the user selected the last element in the dropdown
Me.bAdd.Visible = Me.cbColor.ListIndex = Me.cbColor.ListCount - 1
Me.tbNew.Visible = Me.cbColor.ListIndex = Me.cbColor.ListCount - 1
End Sub
Private Sub UserForm_Initialize()
'Populate from the sheet
For a = 2 To Sheets(1).Cells(Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row, 1).Row
Me.cbColor.AddItem Sheets(1).Cells(a, 1)
Next
'Add option for new type
Me.cbColor.AddItem "Add new type..."
End Sub