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
Related
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
I want to auto-run this private sub when opening the excel sheet.
I tried using Private Sub Workbook_Open() method but as the first private sub does not have a name, it does not work.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet: Set ws = Sheets("Budget- Reporting")
If Range("W6").Value = 0 Then
HideFG
Else
HideF
End If
End Sub
Sub HideF()
'
' HideF Macro
'
'
For i = 1 To ActiveSheet.Shapes.Count
ActiveSheet.Shapes(i).Visible = msoTrue
Next i
ActiveSheet.Shapes.Range(Array("F")).Visible = msoFalse
Application.CommandBars("Selection").Visible = False
End Sub
Sub HideFG()
'
' HideFG Macro
'
'
For i = 1 To ActiveSheet.Shapes.Count
ActiveSheet.Shapes(i).Visible = msoTrue
Next i
ActiveSheet.Shapes.Range(Array("FG")).Visible = msoFalse
Application.CommandBars("Selection").Visible = False
End Sub
I hope that it automatically checks cell W16 when opening the excel file and carries on with HideF macro or HideFG macro. Currently, the two macros run once you actual type on the cell after opening the file.
the easiest way is to use the default Module "ThisWorkbook" which gets executed when opening the excel file. You can find it within your VBA Project Explorer on the left side of the window.
Just take the sub you want to execute and copy it into the space.
Its explained in great detail here:
https://support.office.com/en-us/article/automatically-run-a-macro-when-opening-a-workbook-1e55959b-e077-4c88-a696-c3017600db44
If it is necessary for your usecase this can help you to call a private sub:
Private Sub PrivateCallDemo()
'Module2
Application.Run "Module1.Worksheet_Change"
End Sub
This way your actual Sub could stay in another Module.
You have a few problems. First you don't want Worksheet_Change(ByVal Target As Range)
as that is for events triggers on changes to the workbook, you want Workbook_Open(). This gets stored under ThisWorkbook not a separate module/sheet.
Here is working code, I commented out your ws declaration for testing.
Private Sub Workbook_Open()
'Dim ws As Worksheet: Set ws = Sheets("Budget- Reporting")
If Range("W6").Value = 0 Then
HideFG
Else
HideF
End If
End Sub
Sub HideF()
MsgBox "HideF"
End Sub
Sub HideFG()
MsgBox "HideFG"
End Sub
Here is a screenshot of my editor.
G.M. posted a great resource as well found here --> https://support.office.com/en-us/article/automatically-run-a-macro-when-opening-a-workbook-1e55959b-e077-4c88-a696-c3017600db44
I just put the modules in the same spot for the screenshot, but you can put them separately and still use the Call HideFG method if you want to store your modules separately from the workbook_open event as I would want to.
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
I work with sheets named; Rev00, Rev01, Rev02 etc - among other sheets in my workbook.
It would be very helpful (in order to compare the sub-summaries of different revisions) to set the exact same multiple-filter - as set in active sheet - in only all sheets beginning with "Rev".
This action should most wanted be activated by double Click in Range("A1") or somewhere like that (I dont want button on this one).
If possible next double Click in Range("A1") should reset filters.
Sub Test()
Dim ws As Worksheet, str As String
For Each ws In Worksheets
str = Left(ws.Name, 3)
If str = "Rev" Then
' set filter as in active.sheet
End If
Next ws
End Sub
... and I am stuck ....
will anyone guide me on this?
Yes it is possible. :) Here is a basic sample on how it should work.
Sub Test()
Dim ws As Worksheet, str As String
For Each ws In Worksheets
str = Left(ws.Name, 3)
If UCase(str) = "REV" Then
With ws
'~~> Remove any filters
.AutoFilterMode = False
With <YOUR RANGE>
.AutoFilter Field:=<RELEVANT FIELD>, _
Criteria1:=<YOUR CRITERIA>
'
'~~> Rest of the code
'
End With
'~~> Remove any filters
'.AutoFilterMode = False
End With
End If
Next ws
End Sub
Here you can see Autofilter in action :)
To call the above code by clicking Range A1, you can use the Worksheet_BeforeDoubleClick event.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A1")) Is Nothing Then
'
'~~> Your code goes here
'
Cancel = True
End If
End Sub
Regarding your query about making Range A1 respond as an ON/OFF switch, you can use a boolean variable s shown HERE
I have to update a Excel file, which contains a Visual Basic routine attached to a button.
I tried to prevent the routine from run with empty data and wanted to do an early return:
Sub FillProductDetail()
Dim wks As Worksheet
set wks = Worksheets("Product Detail")
Dim ProductToShow As String
ProductToShow = wks.Range("C4")
wks.Rows("5:1000")Delete Shift :=xlUp
If ProductToShow = "" Then
Return
End If
..... many lines which take forever if ProductToShow is empty
End Sub
I know how to include the rest of the function in the If statement, that works, but then everything is indented even further to the right. I have seen the Return statement before in Basic.
You should use Exit Sub
in a subroutine
Is this what you mean?
Option Explicit
Sub FillProductDetail()
Dim wks As Worksheet
Set wks = ThisWorkbook.ActiveSheet
Dim ProductToShow As String
ProductToShow = wks.Range("C4")
wks.Rows("5:1000").Delete Shift:=xlUp
If ProductToShow = "" Then GoSub MyRoutine
Exit Sub
MyRoutine:
MsgBox "Empty cell"
Return
End Sub