Changing multiple cells values using a command Button - excel

I am trying to figure out how to change 3 cells on 3 different sheets to the same value as the Command Button Caption. I have managed to get it working if there is only one command but can't seem to get it to work on multiple commands.
Private Sub CmdSME100_Click()
Worksheets("Calculator").Range("I1") = Me.CmdSME100.Caption
Worksheets("Tariff Matrix").Range("A1") = Me.CmdSME100.Caption
Worksheets("Bolt-On Matrix").Range("A1") = Me.CmdSME100.Caption
End Sub
As it stands this is the code i am trying to get to work. and i can't seem to figure out why it wont work on all the different sheets.
I need this to work as the cells that i am asking the code to change then trigger an auto filter.
Any advise will be greatly appreciated.
Thanks

Maybe you can try "activating" the sheets. Considering "Calculator" is Sheet1, "Tariff Matrix" is Sheet2 and "Bolt-On Matrix" is Sheet 3;
Private Sub CmdSME100_Click()
Sheet1.Activate
Sheet1.Range("A1") = Me.CmdSME100.Caption
Sheet2.Activate
Sheet2.Range("A1") = Me.CmdSME100.Caption
Sheet3.Activate
Sheet3.Range("A1") = Me.CmdSME100.Caption
End Sub

Set a sheet variable to access them
Private Sub CmdSME100_Click()
Dim ws As Excel.Worksheet
Set ws = Application.Worksheets(1)
ws.Range("I1") = Me.CmdSME100.Caption
Set ws = Application.Worksheets(2)
ws.Range("A1") = Me.CmdSME100.Caption
Set ws = Application.Worksheets(3)
ws.Range("A1") = Me.CmdSME100.Caption
End Sub
If your worksheets aren't reliably in the same index you can search for them by name.
The code would look something like this.
'Find the worksheet named *BBCOV*
iFoundWorksheet = 0
For iIndex = 1 To Application.ActiveWorkbook.Worksheets.Count
Set ws = Application.Worksheets(iIndex)
If UCase(ws.Name) = "BBCOV-PURGED" Then
iFoundWorksheet = iIndex
Exit For
End If
Next iIndex
If iFoundWorksheet = 0 Then
MsgBox "No worksheet was found with the name BBCOV-PURGED (this is not case sensetive). Aborting."
GoTo Abort
End If
Set ws = Application.Worksheets(iFoundWorksheet)
ws.Activate

I don't think you can grab the caption quite like that.
Try this instead:
ActiveSheet.Buttons(Application.Caller).Caption
So...
Private Sub CmdSME100_Click()
Worksheets("Calculator").Range("I1") = ActiveSheet.Buttons(Application.Caller).Caption
Worksheets("Tariff Matrix").Range("A1") = ActiveSheet.Buttons(Application.Caller).Caption
Worksheets("Bolt-On Matrix").Range("A1") = ActiveSheet.Buttons(Application.Caller).Caption
End Sub

Related

Delete named ranges used for chart series when deleting the chart

Is there any way to delete named ranges used in chart series when the chart is being deleted?
I use named ranges quite extensively in my daily work, also for charting. When I create charts I often name data ranges and THEN use them for chart series.
I am looking for a way to delete USED named ranges WHEN I delete the chart. I thought about chart "delete" event, but I cannot find any info about it (does it even exist???).
The second issue is how to determine which ranges have been used for chart series? Deleting the named ranges is easy, but how to actually determine, which ranges have been used in chart series?
All help is MUCH appreciated. Apologies but I cannot provide you with any code, as I have no idea how to set things up
Try the next code please. The USED named ranges cannot be extract directly. I used a trick to extract the ranges form SeriesCollection formula. Then compare them with names RefersToRange.Address and delete the matching name. It (now) returns a boolean value in case of match (only to see it in Immediate Window), but not necessary for your purpose. The code also delete the invalid names (having their reference lost).
Edited: I made some researches and I am afraid it is not possible to create a BeforeDelete event... It is an enumeration of events able to be created for a chart object, but this one is missing. I like to believe that I found a solution for your problem, respectively:
Create a class able to enable BeforeRightClick event. Name it CChartClass and write the next code:
Option Explicit
Public WithEvents ChartEvent As Chart
Private Sub ChartEvent_BeforeRightClick(Cancel As Boolean)
Dim msAnswer As VbMsgBoxResult
msAnswer = MsgBox("Do you like to delete the active chart and its involved Named ranges?" & vbCrLf & _
" If yes, please press ""Yes"" button!", vbYesNo, "Chart deletion confirmation")
If msAnswer <> vbYes Then Exit Sub
Debug.Print ActiveChart.Name, ActiveChart.Parent.Name
testDeleteNamesAndChart (ActiveChart.Parent.Name)
End Sub
Create another class able to deal with workbook and worksheet events, name it CAppEvent and copy the next code:
Option Explicit
Public WithEvents EventApp As Excel.Application
Private Sub EventApp_SheetActivate(ByVal Sh As Object)
Set_All_Charts
End Sub
Private Sub EventApp_SheetDeactivate(ByVal Sh As Object)
Reset_All_Charts
End Sub
Private Sub EventApp_WorkbookActivate(ByVal Wb As Workbook)
Set_All_Charts
End Sub
Private Sub EventApp_WorkbookDeactivate(ByVal Wb As Workbook)
Reset_All_Charts
End Sub
Put the next code in a standard module (need to create a classes array in order to start the event for all existing sheet embedded charts):
Option Explicit
Dim clsAppEvent As New CAppEvent
Dim clsChartEvent As New CChartClass
Dim clsChartEvents() As New CChartClass
Sub InitializeAppEvents()
Set clsAppEvent.EventApp = Application
Set_All_Charts
End Sub
Sub TerminateAppEvents()
Set clsAppEvent.EventApp = Nothing
Reset_All_Charts
End Sub
Sub Set_All_Charts()
If ActiveSheet.ChartObjects.Count > 0 Then
ReDim clsChartEvents(1 To ActiveSheet.ChartObjects.Count)
Dim chtObj As ChartObject, chtnum As Long
chtnum = 1
For Each chtObj In ActiveSheet.ChartObjects
Set clsChartEvents(chtnum).ChartEvent = chtObj.Chart
chtnum = chtnum + 1
Next
End If
End Sub
Sub Reset_All_Charts()
' Disable events for all charts
Dim chtnum As Long
On Error Resume Next
Set clsChartEvent.ChartEvent = Nothing
For chtnum = 1 To UBound(clsChartEvents)
Set clsChartEvents(chtnum).ChartEvent = Nothing
Next ' chtnum
On Error GoTo 0
End Sub
Sub testDeleteNamesAndChart(strChName As String)
Dim rng As Range, cht As Chart, sFormula As String
Dim i As Long, j As Long, arrF As Variant, nRng As Range
Set cht = ActiveSheet.ChartObjects(strChName).Chart
For j = 1 To cht.SeriesCollection.Count
sFormula = cht.SeriesCollection(j).Formula: Debug.Print sFormula
arrF = Split(sFormula, ",")
For i = 0 To UBound(arrF) - 1
If i = 0 Then
Set nRng = Range(Split((Split(sFormula, ",")(i)), "(")(1))
Else
Set nRng = Range(Split(sFormula, ",")(i)) '(1)
End If
Debug.Print nRng.Address, matchName(nRng.Address)
Next i
ActiveSheet.ChartObjects(strChName).Delete
End Sub
Private Function matchName(strN As String) As Boolean
Dim Nm As Name, strTemp As String
For Each Nm In ActiveWorkbook.Names
On Error Resume Next
strTemp = Nm.RefersToRange.Address
If Err.Number <> 0 Then
Err.Clear
Nm.Delete
Else
If strN = strTemp Then
Nm.Delete
matchName = True: Exit Function
End If
End If
On Error GoTo 0
Next
End Function
Use the next events code in the ThisWorkbook module:
Option Explicit
Private Sub Workbook_Open()
InitializeAppEvents
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
TerminateAppEvents
End Sub
Please confirm that it worked as you need

How to ask for Checkbox (True/False) in Macro using If-function

How can I hide/show columns and rows in another sheet ("Project Plan") within the same workbook using a checkbox? If the checkbox is checked, they should not be hidden. If the checkbox is not checked, they should be hidden. The checkboxes are in an own sheet ("Guidelines").
I tried the following but get the error "Run time error '424': Object required'"
Sub Team_Availability_Click()
Dim rng As Range
Set rng = ThisWorkbook.Sheets("Project Plan").Rows("5:8")
If Team_Availability.Value = False Then
rng.Hidden = True
ElseIf Team_Availability.Value = True Then
rng.Hidden = False
End If
End Sub
Alternatively, I tried out this way, found in a similar question using some kind of object:
Checking if a worksheet-based checkbox is checked
Sub Team_Availability_Click()
Dim rng As Range
Set rng = ThisWorkbook.Sheets("Project Plan").Rows("5:8")
If ThisWorkbook.Worksheets("Guidelines").Shapes("Team_Availability").OLEFormat.Object.Value = 0 Then
rng.Hidden = True
ElseIf ThisWorkbook.Worksheets("Guidelines").OLEFormat.Object.Value = 1 Then
rng.Hidden = False
End If
End Sub
Here I get the error
The Item with the specified name wasn't found.
I did not introduce the dim/set I guess. Now, this is the newest version:
Now I get the error in in line Set cb = ActiveSheet... saying
The item with the specified name wasn't found.
Sub Team_Availability_Click()
Dim cb As Shape
Dim rng As Range
Set cb = ThisWorkbook.Sheets("Guidelines").Shapes("Team_Availability")
Set rng = ThisWorkbook.Sheets("Project Plan").Rows("5:8")
If ThisWorkbook.Sheets("Guidelines").Shapes("Team_Availability").OLEFormat.Object.Value = -4146 Then
rng.Hidden = True
ElseIf ThisWorkbook.Sheets("Guidelines").Shapes("Team_Availability").OLEFormat.Object.Value = 1 Then
rng.Hidden = False
End If
End Sub
I've looked at your code and didn't really work when I tried it. This code worked for the task you describes hope it helps.
Sub CheckBoxHIDE()
Dim ws As Worksheet
Dim chk As CheckBox
Set ws = ActiveSheet
Set chk = ws.CheckBoxes(Application.Caller)
Select Case chk.Value
Case 1 'box is checked
Columns("D").Hidden = True
Case Else 'box is not checked
'do nothing
End Select
End Sub
I found the error together with a friend. In the top left corner I did not assign the specific name to the Control CheckBox. I had just set the macro/sub name and the description. Now it runs.

I want to set multiple sheets as the range for macro

I want to set multiple sheets(sheet1 , sheet2) at the start of the macro and at the moment it is not working.
Private Sub Workbook_Open()
'Dim ws As Worksheet: Set ws = Sheets("sheet1","sheet2")
If Range("W6").Value = 0 Then
Call HideFG
Else
Call HideF
End If
End Sub
you appear to be trying to gather multiple sheets into one reference:
Set ws = Sheets("sheet1","sheet2")
You can almost do this with:
Sheets(Array("sheet1","sheet2"))
However, you have to work on one sheet at a time.. so you need to use it like so:
For Each ws In Sheets(Array("sheet1", "sheet2"))
If ws.Range("W6").Value = 0 Then
Call HideFG
Else
Call HideF
End If
Next
Am I guessing right what You mean?
Private Sub Workbook_Open()
Dim i As Long
For i = 1 To ThisWorkbook.Sheets.Count
With ThisWorkbook.Sheets(i)
If .Range("W6").Value = 0 Then
Call HideFG
Else
Call HideF
End If
End With
Next
End Sub

userform with vlookup function from different sheets when i click an optionbutton for each lookup value

I have to know, is this possible that the single combo box that had a lists from 2 different sheets by using option buttons. this works well. but the vlookup function is working for sheet 1 only not sheet 2.
explanation:
in my userform,
1 combobox = cmbbx1
2 option buttons = 1.hq 2.whs
2 textboxes = 1.txtbx1 2.txtbx2
When I click on the option button hq the list of sheet1 is shown in combobox. then another 2 textboxes already coded with Application.WorksheetFunction.Vlookup, so they're showing the given cell value.
but i can't make it work when i click on the option button whs. in this time combobox is showing the list from sheet2 but vlookup not working here.
here is the code what i get from another source for vlookup function.
Private Sub CmbBX1_AfterUpdate()
'Check to see if value exists
If WorksheetFunction.CountIf(Sheet2.Range("B:B"), Me.CmbBX1.Value) = 0 Then
MsgBox "Employee Not Registered"
Me.CmbBX1.Value = ""
Exit Sub
End If
'Lookup values based on control
With Me
.TxBx1 = Application.WorksheetFunction.VLookup(Me.CmbBX1, Sheet2.Range("Emp_ltl"), 2, 0)
.TxBx2 = Application.WorksheetFunction.VLookup(Me.CmbBX1, Sheet2.Range("Emp_ltl"), 3, 0)
End With
End Sub
This is the code I used for the Option buttons:
Option Explicit
Public myList As Variant
Private Sub hq_Click()
myList = ThisWorkbook.Worksheets("LTL").Range("Emp_ltl").Value
Me.CmbBX1.List = myList
End Sub
Private Sub whs_Click()
myList = ThisWorkbook.Worksheets("LTS").Range("Emp_ltS").Value
Me.CmbBX1.List = myList
End Sub
I believe something like the following will do it:
Private Sub CmbBX1_AfterUpdate()
If hq.Value = True Then 'check if hq is selected
Dim ws As Worksheets: Set ws = Worksheets("LTL") 'declare your worksheet and your range
Dim rng As Range: Set rng = ws.Range("Emp_ltl")
myList = ThisWorkbook.Worksheets("LTL").Range("Emp_ltl").Value
Me.CmbBX1.List = myList
ElseIf whs.Value = True Then 'if whs is selected
Dim ws As Worksheets: Set ws = Worksheets("LTS") 'declare and set your worksheet and range
Dim rng As Range: Set rng = ws.Range("Emp_ltS")
myList = ThisWorkbook.Worksheets("LTS").Range("Emp_ltS").Value
Me.CmbBX1.List = myLis
Else
MsgBox "No Option has been selected"
Exit Sub
End If
'Check to see if value exists
If WorksheetFunction.CountIf(ws.Range("B:B"), Me.CmbBX1.Value) = 0 Then
MsgBox "Employee Not Registered"
Me.CmbBX1.Value = ""
Exit Sub
End If
'Lookup values based on control
With Me
.TxBx1 = Application.WorksheetFunction.VLookup(Me.CmbBX1, rng, 2, 0)
.TxBx2 = Application.WorksheetFunction.VLookup(Me.CmbBX1, rng, 3, 0)
End With
End Sub

Same Worksheet_Activate Code But With Different Ranges Not Working on Sheet 2

First of all, I know nothing about macros and vba used in Excel and other applications. I copied from the internet and ran the following code in sheet 1 as:
Option Explicit
Private Sub Worksheet_Activate()
Dim r As Range, c As Range
Set r = Range("a129:a1675")
Application.ScreenUpdating = False
For Each c In r
If Len(c.Text) = 0 Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c
Application.ScreenUpdating = True
End Sub
The code is working fine in Sheet 1 but the same code but with different range,i.e. "a5:a100" is not working for sheet 2.
Do we need to deactivate the code for sheet 1?
Thanks in Advance,
Regards,
ID
You might create one sub like this one and place it in a standard code module, for example Module1' (you will have to insert it: Right-click in the Project explorer while selecting the workbook's VBA project, selectInsertandModule`).
Option Explicit
Sub HideRows(Rng As Range)
Dim Ws As Worksheet
Dim R As Long
Application.ScreenUpdating = False
With Rng
Set Ws = .Worksheet
For R = 1 To .Rows.Count
Ws.Rows(.Row).EntireRow.Hidden = Not CBool(Len(.Cells(R)))
Next R
End With
Application.ScreenUpdating = True
End Sub
Then call that same sub from all the worksheets to be affected, each one with a different range as argument.
Option Explicit
Private Sub Worksheet_Activate()
HideRows Range("A1:A1675")
End Sub
The idea is that the range should have only one column. If you feed a multi-column range the Hidden status of the row will depend upon the last cell's content in each row.

Resources