I want to write a code that works whether if I select one or multiple charts in Excel.
Actually I use this code, but it fail when only one chart is seleted :
Dim obj As Object
'Check if any charts have been selected
If Not ActiveChart Is Nothing Then
MsgBox ("Select multiple charts")
Else
For Each obj In Selection
'If more than one chart selected
If TypeName(obj) = "ChartObject" Then
Call AnotherMacro(obj.Chart)
End If
Next
End If
I'm looking for a solution working into a unique Sub.
Thanks for your help
Please, try the next way:
Sub iterateSelectedCharts()
Dim obj As Object
If TypeName(Selection) = "ChartArea" Then 'for the case of only one selected chart:
'Call AnotherMacro(ActiveChart)
ElseIf TypeName(Selection) = "DrawingObjects" Then
For Each obj In Selection
If TypeName(obj) = "ChartObject" Then
'Call AnotherMacro(obj.Chart)
End If
Next obj
Else
MsgBox ("Please, select charts") 'for the case when selection contains
'other type of object(s): cells, rectangles, circles etc.
End If
End Sub
Related
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.
I have this code but it only work for my first row.
It is suppose to look if the checkbox on B, C or D is checked, and if so, a date + username will automaticaly fill in F and G.
here is a picture of my table:
This is what my code looks like:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("B2") Or Range("C2") Or Range("D2") = True Then
Range("G2").Value = Environ("Username")
Range("F2").Value = Date
Else
Range("F2:G2").ClearContents
End If
End Sub
Enter this code in a regular module, select all your checkboxes and right-click >> assign macro then choose ReviewRows.
This will run the check whenever a checkbox is clicked - a bit of overhead since all rows will be checked, but should not be a big deal.
Sub ReviewRows()
Dim n As Long
For n = 1 To 100 'for example
With Sheet1.Rows(n)
If Application.CountIf(.Cells(2).Resize(1, 3), "TRUE") > 0 Then
If Len(.Cells(6).Value) = 0 Then 'only enter if currently empty?
.Cells(6) = Date
.Cells(7) = Environ("Username")
End If
Else
.Cells(6).Resize(1, 2).ClearContents
End If
End With
Next n
End Sub
If you want to be more precise then Application.Caller will give you the name of the checkbox which was clicked, and you can use that to find the appropriate row to check via the linkedCell.
Sub ReviewRows()
Dim n As Long, shp As CheckBox, c As Range, ws As Worksheet
Set ws = ActiveSheet
On Error Resume Next 'ignore error in case calling object is not a checkbox
Set shp = ActiveSheet.CheckBoxes(Application.Caller) 'get the clicked checkbox
On Error GoTo 0 'stop ignoring errors
If Not shp Is Nothing Then 'got a checkbox ?
If shp.LinkedCell <> "" Then 'does it have a linked cell ?
With ws.Range(shp.LinkedCell).EntireRow
If Application.CountIf(.Cells(2).Resize(1, 3), "TRUE") > 0 Then
If Len(.Cells(6).Value) = 0 Then 'only enter if currently empty?
.Cells(6) = Date
.Cells(7) = Environ("Username")
End If
Else
.Cells(6).Resize(1, 2).ClearContents
End If
End With
End If 'has linked cell
End If 'was a checkbox
End Sub
However this appraoch is sensitive to the exact positioning of your checkbox
You have a long way to go!
Unfortunately, If Range("B2") Or Range("C2") Or Range("D2") = True Then is beyond repair. In fact, your entire concept is.
Start with the concept: Technically speaking, checkboxes aren't on the worksheet. They are on a layer that is superimposed over the worksheet. They don't cause a worksheet event, nor are they responding to worksheet events. The good thing is that they have their own.
If Range("B2") Or Range("C2") Or Range("D2") = True Then conflates Range with Range.Value. One is an object (the cell), the other one of the object's properties. So, to insert sense into your syntax it would have to read, like, If Range("B2").Value = True Or Range("C2").Value = True Or Range("D2").Value = True Then. However this won't work because the trigger is wrong. The Worksheet_Change event won't fire when when a checkbox changes a cell's value, and the SelectionChange event is far too common to let it run indiscriminately in the hope of sometimes being right (like the broken clock that shows the correct time twice a day).
The answer, therefore is to capture the checkbox's click event.
Private Sub CheckBox1_Click()
If CheckBox1.Value = vbTrue Then
MsgBox "Clicked"
End If
End Sub
Whatever you want to do when the checkbox is checked must be done where it now shows a MsgBox. You can also take action when it is being unchecked.
I want hide the chart on the some specific condition like if corresponding cell is blank the chart should be invisible. but once that cell value is not blank then again chart should be visible.
I have the below program, but it doesnt work for me. please help.
Sub chart_visibility()
ActiveWorkbook.Sheets("RP0004").Activate
If Range("H32").Value = "" Then
ActiveSheet.Charts("Chart 5").Visible = False
Else
ActiveSheet.Charts("Chart 5").Visible = True
End If
End Sub
E.g:
Sub chart_visibility()
With ActiveWorkbook.Sheets("RP0004")
.ChartObjects("Chart 5").Visible = (Len(.Range("H32").Value)>0)
End With
End Sub
You want the ChartObjects collection and not the Charts collection
What I am trying to do is to create a program that adds combo boxes with some options. These options should then, depending on the option selected, change some values in some cells that I specify in code.
This is how I make the combo lists:
Private Sub Workbook_Open()
With Worksheets("Sheet1").Columns("E")
.ColumnWidth = 25
End With
For i = 1 To 6
Set curCombo = Sheet1.Shapes.AddFormControl(xlDropDown, Left:=Cells(i, 5).Left, Top:=Cells(i, 5).Top, Width:=100, Height:=15)
With curCombo
.ControlFormat.DropDownLines = 3
.ControlFormat.AddItem "Completed", 1
.ControlFormat.AddItem "In Progress", 2
.ControlFormat.AddItem "To be done", 3
.Name = "myCombo" & CStr(i)
.OnAction = "myCombo_Change"
End With
Next i
End Sub
I want each of the dropdown values trigger the event myCombo_Change and then simply change the cell "D" For example, combo box 3 is located at E3 and I want the "To be done" to clear the cell D3 and the completed to simply store the date (and time) to the cell D3. This should be done for all combo boxes in the E Column.
Private Sub myCombo_Change(index As Integer)
Me.Range("D" & CStr(index)) = Me.myCombo.Value
End Sub
This is the code I started thinking about, but I have no idea how to call the event with an integer as the index parameter NOR how to access the cell using said index.
The effect I want is something along the lines of this:
Use Application.Caller to get the name of the control that called the myCombo_Change event.
Sub myCombo_Change()
Dim curCombo As Shape
Set curCombo = ActiveSheet.Shapes(Application.Caller)
curCombo.TopLeftCell.Offset(0, -1) = Now
End Sub
Assign the myCombo_Change to all existing DropDown:
Sub AssignMacroToAllListBoxes()
Dim sh As Shape
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
For Each sh In ws.Shapes
If TypeName(sh.OLEFormat.Object) = "DropDown" Then
sh.OLEFormat.Object.OnAction = "myCombo_Change"
End If
Next
Next
End Sub
Delete all DropDowns on Sheet1
Sub DeleteAllDropDownsOnSheet()
For Each sh In Sheet1.Shapes
If TypeName(sh.OLEFormat.Object) = "DropDown" Then
sh.Delete
End If
Next
End Sub
I have a file that someone made and I was tasked with simply adding an autoupdater function that updates the cell next to the dropdown menu.
The way the dropdown menu is created is by going to data validation and selecting list and make list in cell. The values are read from elsewhere.
Now, what I tried was to loop over all shapes like this:
Dim dd As DropDown
Dim i As Integer
Debug.Print Sheet1.DropDowns.Count
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Dim s As Shape
For Each s In ws.Shapes
Debug.Print CStr(s.Type)
Next
Next
End Sub
This prints the following:4 is a comment, 8 is a control form
444444444444444444444444444
8
So even though I have many drop down menus none come out when I loop over them.
I wanted to make it so that anyone can add a dropdown box and my code would attach an OnAction Sub that fills in the cell next to the dropdown box so the user can add as many boxes they want, but they have to only remember to keep the cell next to it, to the right for example, empty as it will be overridden.
Dim sh As Shape
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
For Each sh In ws.Shapes
If sh.Type = msoFormControl Then
If sh.FormControlType = xlListBox Then
sh.OLEFormat.Object.OnAction = "UpdateLBCell"
End If
End If
Next
Next
The original code above causes an object error on the innermost line.
Am I just stupid or is it not possible to loop over these dropdown boxes?
If it is impossible, can I make some other dropdown single select boxes that fit inside a cell? Combobox I tried, but they lie on top and dont match.
Any insight in alternative ways to do this is very appreciated as well.
I put a list validation on a few cells, then ran this code
Sub Test()
Dim dd As DropDown
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Dim s As Shape
For Each s In ws.Shapes
Debug.Print CStr(s.Type), s.Top, s.Left
s.Visible = msoCTrue '<<<<
Next
Next
End Sub
Before and after (yellow cells have data validation):
So it seems as though if you have a "list" data validation set up, Excel manages a single (normally invisible and empty) drop-down which is typically positioned at the current active cell. It's only made visible when that's also one of the cells with validation set up.
EDIT: here's an example of how you could handle updates to cells with drop-down DV lists in a generic way -
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
On Error GoTo haveError
Application.EnableEvents = False
For Each c In Target.Cells
If HasDVList(c) Then
c.Offset(0, 1) = Now
End If
Next c
haveError:
Application.EnableEvents = True
End Sub
'does a cell have DV list?
Function HasDVList(rng As Range)
Dim v
On Error Resume Next
v = rng.Cells(1).Validation.Type
On Error GoTo 0
HasDVList = (v = 3)
End Function
The Shape should be Visible, whether the cell is "clicked-on" or not. I put a single DV dropdown on a sheet and ran:
Sub ShapeLister()
Dim s As Shape
For Each s In ActiveSheet.Shapes
MsgBox s.Type & vbCrLf & s.Name
Next s
End Sub
and got:
Try this on a fresh worksheet and tell us what you see.