I have some code that loops through the ActiveX controls on an Excel worksheet. This logs which checkboxes have been selected.
Dim obj AS OLEObject
For Each obj In ActiveSheet.OLEObjects
If TypeName(obj.Object) = "CheckBox" Then ' loop through all checkboxes to find selections
BooCheck = obj.Object
If BooCheck = True Then
MyArray(j) = obj.Name 'if checkbox selected then store the associated Name
j = j + 1
End If
End If
Next obj
This all works fine. However, as I have a number of checkboxes that I need to move around I thought I'd group them together by Shift/click in design mode, right click and select the "Group" option. However, if I do this the grouped checkboxes vanish from OLEObjects. Where do they go? Is there a way of altering my code to find them when they are grouped?
The way to reference the OLEObjects is like this:
Public Sub ReferenceTest(oSheet As Worksheet, sGroupName As String)
Dim i As Long
Dim oOle As OLEObject
With oSheet.Shapes.Range(sGroupName).GroupItems
For i = 1 To .Count
Set oOle = .Item(i).OLEFormat.Object
Debug.Print oOle.Name, oOle.Object.Value
Next i
End With
End Sub
Just specify the sheet and group name, e.g.
ReferenceTest ActiveSheet, "Group 1"
Related
I have a worksheet where there is a list of car parts pending delivery from the factory. I need to populate column I with a checkbox in each cell.
I created a button called "CREATE CHECKBOXES" that looks at how many rows of data exists then populates each cell of column I with ActiveX checkboxes from CheckBox1 up to CheckboxN (n = number of rows containing data). That part is already figured out.
Next when the user checks any of the checkboxes, it must pop up a userform with 2 data field inputs that will be inserted on column J and K in the same row of the checked checkbox. Where I got stuck in the code is the event that triggers the userform to pop when any of the checkboxes is checked.
I saw Event triggered by ANY checkbox click), but now due to the code counting the checkboxes as shapes, I can't add any sort of button to add a macro to it.
I had to delete the "CREATE CHECKBOXES" button, otherwise the code from the linked post won't work.
How can I make this userform trigger event happen when any of the checkboxes are checked and maintain the shape buttons?
A few things must happen after that, but I think I can handle it.
I created a class module, named ChkClass, with this code:
' put all this code in class a module and name the class module "ChkClass"
Option Explicit
Public WithEvents ChkBoxGroup As MSForms.CheckBox
Private Sub ChkBoxGroup_Change()
Debug.Print "ChkBoxGroup_Change"
End Sub
Then pasted this in the sheet code:
' this goes into sheet code
Private Sub Worksheet_Activate()
activateCheckBoxes
End Sub
After that, I created a module and it was slightly adapted from the linked post:
' this code goes into a module
Option Explicit
Dim CheckBoxes() As New ChkClass
Sub doCheckBoxes()
makeCheckBoxes
activateCheckBoxes
End Sub
Sub makeCheckBoxes()
Sheets(2).Select
Dim c As Range
Dim ultlinha As Integer
ultlinha = Range("A2").End(xlDown).Row
Range(Cells(2, 9), Cells(ultlinha, 9)).Select
For Each c In Selection
With ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Left:=c.Left, Top:=c.Top, Width:=c.Width, Height:=c.Height)
DoEvents
.Object.Caption = "FATURADO"
.LinkedCell = c.Offset(0, 3).Address
.Object.Value = 0 'sets checkbox to false
.Object.Font.Name = "Calibri"
.Object.Font.Size = 9
.Object.Font.Italic = True
.Object.BackStyle = fmBackStyleTransparent
End With
Next
Range("a1").Select
End Sub
Sub activateCheckBoxes() ' assigns all checkBoxes on worksheet to ChkClass.ChkBoxGroup
Dim sht As Worksheet
Set sht = ActiveSheet
ReDim CheckBoxes(1 To 1)
Dim i As Integer
For i = 1 To sht.Shapes.Count
ReDim Preserve CheckBoxes(1 To i)
Set CheckBoxes(i).ChkBoxGroup = sht.Shapes(i).OLEFormat.Object.Object
Next i
End Sub
The problem lies in this line:
Set CheckBoxes(i).ChkBoxGroup = sht.Shapes(i).OLEFormat.Object.Object
If there is no other button or shape in the sheet, it runs correctly. If I add a single button or form to add the macro to it, it doesn't work.
If you only want to "activate" the checkboxes then you can loop over the sheet's OLEObjects collection and only capture the checkboxes.
Sub activateCheckBoxes()
Dim sht As Worksheet, obj As OLEObject, n As Long
Set sht = ActiveSheet
ReDim CheckBoxes(1 To 1)
Dim i As Integer
For Each obj In sht.OLEObjects
If TypeName(obj.Object) = "CheckBox" Then 'is a checkbox?
n = n + 1
If n > 1 Then ReDim Preserve CheckBoxes(1 To n)
Set CheckBoxes(n).ChkBoxGroup = obj.Object
End If
Next obj
End Sub
So I'm trying to use three Comboboxes to have a selection list for data input. I'm needing to make a selection in this order: Region -> Site -> Maintenance Plant. When a selection is made in the Region Combobox, then the Site Combobox list should filter to the options that pertain to the corresponding Region selection. Im thinking either a pivot table or vLookup needs to be used but I'm at a loss and have no clue how to get this done. Please help and thank you very much in advance.
Private Sub UserForm_Initialize()
Dim CreateBy As Range
Dim Region As Range
Dim Site As Range
Dim MaintPlant As Range
Dim Dept As Range
Dim Act As Range
Dim ImpActTyp As Range
Dim ValCat As Range
Dim ws As Worksheet
Set ws = Worksheets("LookupLists")
For Each CreateBy In ws.Range("RosterList")
With Me.CboCreateBy
.AddItem CreateBy.Value
End With
Next CreateBy
For Each Region In ws.Range("RegionList")
With Me.CboRegion
.AddItem Region.Value
End With
Next Region
For Each Site In ws.Range("SiteList")
With Me.CboSite
.AddItem Site.Value
End With
Next Site
For Each MaintPlant In ws.Range("MaintPlantList")
With Me.CboMntPlant
.AddItem MaintPlant.Value
End With
Next MaintPlant
For Each Dept In ws.Range("DeptList")
With Me.CboDept
.AddItem Dept.Value
End With
Next Dept
For Each Act In ws.Range("ActList")
With Me.CboAct
.AddItem Act.Value
End With
Next Act
For Each ImpActTyp In ws.Range("ImpActTypList")
With Me.CboImpActTyp
.AddItem ImpActTyp.Value
End With
Next ImpActTyp
For Each ValCat In ws.Range("ValCatList")
With Me.CboValCat
.AddItem ValCat.Value
End With
Next ValCat
Me.DateTextBox.Value = Format(Date, "Medium Date")
Me.PLife.Value = 0
Me.CSE.Value = 0
Me.CboRegion.SetFocus
End Sub
Get ready, because I'm about to reimagine your entire code here. I strongly recommend you create a backup of your original code module or workbook just due to the vast differences and if our ideas didn't align properly.
This will perform real-time filtering on your table, so keep this in mind using this method.
I did perform some testing on the following code, but I am human and threw this together in 20 mins or so. I wouldn't implement this in a real setting until you have fully tested the code and are comfortable with it.
And I just wanted to thank you for your use of Named Ranges. This made coding this easier.
You must enable the Microsoft Scripting Runtime library. This is used to grab the unique values from your tables. (Tools > References)
So to get things started, here is the entire code for your userform's code module:
Option Explicit
Private ws As Worksheet
Private tblLO As ListObject
Private Sub combo_region_Change()
Application.EnableEvents = False
Me.combo_maintPlant.Clear
Me.combo_site.Clear
'This is the first filter, so no worries about clearing entire AutoFilter
tblLO.AutoFilter.ShowAllData
Select Case Me.combo_region.Value
Case ""
Me.combo_site.Value = ""
Me.combo_maintPlant.Value = ""
Me.combo_site.Enabled = False
Me.combo_maintPlant.Enabled = False
Case Else
'If data is entered into first combobox, filter the table
tblLO.Range.AutoFilter 1, Me.combo_region.Value
'Populate the site combo box with new data
populateSiteCombo
'Enable the Site Combobox for user input
Me.combo_site.Enabled = True
End Select
Application.EnableEvents = True
End Sub
Private Sub combo_site_Change()
Application.EnableEvents = False
Me.combo_maintPlant.Clear
'Clear the filtering, then readd the Region's filter
tblLO.AutoFilter.ShowAllData
tblLO.Range.AutoFilter 1, Me.combo_region
Select Case Me.combo_site.Value
Case ""
Me.combo_maintPlant.Value = ""
Me.combo_maintPlant.Enabled = False
Case Else
'If data is entered into first combobox, filter the table
tblLO.Range.AutoFilter 2, Me.combo_site.Value
'Populate the Plant combo box with new data
populatePlantCombo
'Enable the Plant Combobox for user input
Me.combo_maintPlant.Enabled = True
End Select
Application.EnableEvents = True
End Sub
Private Sub populatePlantCombo()
'Grab unique values from Region column using Dictionary
Dim i As Long, regionDict As New Scripting.Dictionary
Dim arrReg() As Variant
'If it filters only 1 item, then it's just a single cell and not an arr
With ws.Range("MaintPlantList").SpecialCells(xlCellTypeVisible)
If .Count = 1 Then
Me.combo_maintPlant.AddItem .Value
Exit Sub
Else
arrReg = .Value
End If
End With
With New Scripting.Dictionary
For i = 1 To UBound(arrReg)
If Not .Exists(arrReg(i, 1)) Then
.Add arrReg(i, 1), "" 'We only add to dictionary for tracking
Me.combo_maintPlant.AddItem arrReg(i, 1)
End If
Next
End With
End Sub
Private Sub populateSiteCombo()
'Grab unique values from Region column using Dictionary
Dim i As Long, regionDict As New Scripting.Dictionary
Dim arrReg() As Variant
'If it filters only 1 item, then it's just a single cell and not an arr
With ws.Range("SiteList").SpecialCells(xlCellTypeVisible)
If .Count = 1 Then
Me.combo_site.AddItem .Value
Exit Sub
Else
arrReg = .Value
End If
End With
With New Scripting.Dictionary
For i = 1 To UBound(arrReg)
If Not .Exists(arrReg(i, 1)) Then
.Add arrReg(i, 1), "" 'We only add to dictionary for tracking
Me.combo_site.AddItem arrReg(i, 1)
End If
Next
End With
End Sub
Private Sub populateRegionCombo()
'Grab unique values from Region column using Dictionary
Dim i As Long, regionDict As New Scripting.Dictionary
Dim arrReg() As Variant
arrReg = ws.Range("RegionList").Value
With New Scripting.Dictionary
For i = 1 To UBound(arrReg)
If Not .Exists(arrReg(i, 1)) Then
.Add arrReg(i, 1), "" 'We only add to dictionary for tracking
Me.combo_region.AddItem arrReg(i, 1)
End If
Next
End With
End Sub
Private Sub UserForm_Initialize()
Set ws = ThisWorkbook.Worksheets("LookupLists") 'Module-defined var
Set tblLO = ws.ListObjects("Table1") 'Module-defined var
tblLO.AutoFilter.ShowAllData
Me.combo_maintPlant.Enabled = False
Me.combo_site.Enabled = False
'We only populate this one during init because the others
'will populate once a value is used in this box
populateRegionCombo
End Sub
If you decided to scroll down to understand what's going on here, then great.
Let's start with the initialization:
Private Sub UserForm_Initialize()
Set ws = ThisWorkbook.Worksheets("LookupLists") 'Module-defined var
Set tblLO = ws.ListObjects("Table1") 'Module-defined var
tblLO.AutoFilter.ShowAllData
Me.combo_maintPlant.Enabled = False
Me.combo_site.Enabled = False
'We only populate this one during init because the others
'will populate once a value is used in this box
populateRegionCombo
End Sub
We defined the module variables ws and tblLO. I'm not a huge fan of module-scoped variables, but we can usually get along when they are private vars to a userform module. Now the other functions in the code module can access these.
We reset autofiltering and disabled the two combo boxes that shouldn't be used until a selection is made for the region. Only after the region is selected will the next box be available for selection. We will handle these using Change Events for the comboboxes.
The userform is mostly controlled by the combo_region_change and combo_site_change events. Everytime region_change is fired, it will clear all the other combo boxes to redetermine it's new value. Then it will refilter as appropriately. The combo_site does the same, but it only clears the maintaince box. These event handlers also establish which of the other combox boxes are enabled depending on their values. So if you where to completely clear the site box for example, it will disable access to the Plant box again.
Finally you just have the "populate subs". Their jobs are simply to (re)populate the next combo box once the appropriate event handler is triggered.
Tip: If you feel the need to reset the filtering once you close your userform, you can just place the code to reset it in a UserForm_Terminate() event. It makes no difference to the above code if autofilter is enabled or not prior to it running, so that is preference only.
Can someone tell me what the syntax is to determine the controlX checkbox name?
I have approximately 4 check boxes and this may potentially grow, so I'd like a method of passing through the checkbox name dynamically rather than writing the same execution 4-9 times.
My intention is to pass through the checkbox name as a variable so I do not have to repeat the below code for each checkbox. Also, does anyone know how to reference a named range to a specific checkbox? The code I have so far is:
Sub CheckBox1_Click()
Application.ScreenUpdating = False
Dim strCheck As String
strCheck = CheckBox1.Value
If strCheck = True Then
Range("RevAssp_CCV").Select
Selection.EntireRow.Hidden = False
Else
Range("RevAssp_CCV").Select
Selection.EntireRow.Hidden = True
End If
End Sub
Thanks in advance
The easiest way would be to create a custom wrapper class, create an array of objects of said class and then hook into the event there.
You can then (for example) check the Caption and set the "hidden" of the NamedRange.EntireRow equal to the value (e.g. checked is invisible, unchecked is visible)
The most basic implementation of this would be as follows:
CustomCheckBox Class module:
Private WithEvents p_chkBox As MSForms.checkbox
Public Property Let box(value As MSForms.checkbox)
Set p_chkBox = value
End Property
Public Property Get box() As MSForms.checkbox
Set box = p_chkBox
End Property
Private Sub p_chkBox_Click()
Range(p_chkBox.Caption).EntireRow.Hidden = p_chkBox.value
End Sub
And in a regular module:
Public cCheckBox() As CustomCheckBox
Sub Test()
Dim ws As Worksheet
Dim oleObj As OLEObject
Dim i As Integer
i = 0
For Each ws In ThisWorkbook.Worksheets
For Each oleObj In ws.OLEObjects
If TypeName(oleObj.Object) = "CheckBox" Then
ReDim Preserve cCheckBox(0 To i)
Set cCheckBox(i) = New CustomCheckBox
cCheckBox(i).box = oleObj.Object
i = i + 1
End If
Next oleObj
Next ws
End Sub
The regular module puts all checkboxes into 1 array, which is a public variable so it will be available even after the code has run. You could also place this code in the Workbook Module as Private Sub Workbook_Open to ensure that the checkboxes will be initialized properly in all cases.
Keep in mind that if the Named Range for the caption of the Checkbox doesn't exist, this will throw errors.
To get back to your example, you could now just add two checkboxes on your sheets and set the caption of the first one to "RevAssp_CCV" and the second one to whatever other named range you wish to toggle.
I am trying to loop through a ActiveX checkboxes that are grouped together in a frame on a worksheet. I have been able to find all the checkboxes, but I am not able to get the GroupName properties through the VBA code. To figure out the script I have been just using a simple workbook that has two checkboxes grouped in a frame that are simply named Checkbox1 and Checkbox2 and they have the same GroupName. This is what I have so far
Sub test2()
Dim i As Integer
Dim cb As Object
Dim countItems As Integer
Dim checkBox As Object
For Each cb In ActiveSheet.Shapes
If cb.Name Like "Group*" Then
countItems = cb.GroupItems.Count
For i = 1 To countItems
If cb.GroupItems(i).Name Like "Check*" Then
Debug.Print cb.GroupItems(i).Name
End If
Next i
End If
Next cb
End Sub
I have been searching around the internet for solutions, but the ones that I have seen do not seem to fit because my checkboxes are grouped together.
Sub test4()
Dim ole As OLEObject
For Each ole In ActiveSheet.OLEObjects
If TypeName(ole.Object) = "CheckBox" Then
Debug.Print ole.Object.GroupName
If ole.Object.GroupName = Group And ole.Object.Value = True Then
Debug.Print ole.Object.GroupName
End If
End If
Next ole
GroupClear = True
End Sub
This seemed to work to find the checkboxes that were in the worksheet just fine but not grouped together.
Thank you for the help
The comment 1 helped getting to the right spot. The grouping seemed to require a bit of digging though the properties to get to the Object.Object.GroupName
Debug.Print cb.OLEFormat.Object.Interior.Parent.ShapeRange.GroupItems(i).Parent.Item(i).OLEFormat.Object.Object.GroupName
After the Object.Object property most of the properties were available for searching or edit that were useful in extra control of the checkbox.
I have a combobox (called userBox) within a sheet called Home. It has one of the options selected, let's say "User A". All I'm trying to do is assign "User A" to string usr, but I keep getting the compile error:
Method or data member not found
Sub fixPls()
Dim row As Integer, col As Integer, usr As String, tbl As String, found As Boolean, k As Integer, payType As String
Set wb = ThisWorkbook
Set ws = wb.Sheets("Home")
ws.Activate
Application.DisplayAlerts = False
Application.ScreenUpdating = False
lastRow = Range("B16").End(xlUp).row
usr = ws.userBox.Value
tbl = ws.tblBox.Value
payType = ws.tpBox.Value
....
EDIT: I tried a dummy program in a new workbook, and it worked. Using an activeX comboBox, why is it different?
Sub blah()
Dim rly As String
rly = Sheets(1).ComboBox1.Value
ThisWorkbook.Sheets(1).Cells(1, 10) = rly
End Sub
Cell J1 returns the value selecting in the comboBox.
If it's an ActiveX control, you need to use the OLEObjects collection to access it:
Debug.Print ws.OLEObjects("userBox").Object.Text
Took me a while to figure it out, but the solution is simple, just disable trusted documents:
File > Options > Trust Center > Trust Center Settings – Go to “Trusted Documents” and click on the button to “Disable Trust Documents” Close Excel and re-open.