How to test an activesheet - vba

Here is my code
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Set Sh = ActiveSheet
If ActiveSheet.Name = "Entrada" Then
Application.Calculation = xlManual
Else
Application.Calculation = x1automatic
End If
End Sub
but all the sheets is going to manual calculation, whats the error?
thx!

You are attempting to change the calculation at application level. I'm guessing you want to use
ActiveSheet.EnableCalculation = True ' or False

Just a thought on your Sh variable assignment. When Sh is passed into the Workbook_SheetActivate event macro, it is the worksheet being activated. You do not need to set it to the active sheet. The following will always report the name of the worksheet being newly activated to the Immediate window (including newly created worksheets).
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Debug.Print Sh.Name
End Sub
So your conditional statement could be tightened up to something like,
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "Entrada" Then
' do something here
Else
' do something else here
End If
End Sub

The values you set to Calculation should be: xlCalculationManualand xlCalculationAutomatic, not xlManual and x1automatic
See MSDN and this site http://www.cpearson.com/excel/optimize.htm

Related

Excel vba when adding or deleting sheet in workbook, show/hide button in main sheet

I have a button with a simple macro that deletes certain sheets.
I'd like to show this button only when those sheets are actually there (I can use worksheets.count because I have 2 "permanent" sheets; if > 2 then I know I have a new sheet and I want to show the button to delete it if I want to).
I think I have to use "Workbook.SheetChange event" because "Worksheet.Change event" doesn't seem to work for me in this case.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim foglio_parametri As Worksheet
Set foglio_parametri = ThisWorkbook.Worksheets("PARAMETRI") 'my main sheet where I want to show/hide the button
Application.ScreenUpdating = True
If Application.Worksheets.Count > 2 Then
foglio_parametri.CommandButton2.Visible = True
Else
foglio_parametri.CommandButton2.Visible = False
End If
End Sub
Thank you very much for your time.
I will not use your names as they are in a foreign language I do not understand .
Let's assume the button you are talking about is in a sheet with the name sheet3 which also has the codename sheet3. The button itself has the name CommandButton1. Let's further assume the certain sheets you are talking about have the names sheet4 and sheet5 then I would add the following code to the workbook module
Option Explicit
Private Sub Workbook_Open()
Sheet3.HidecmdBtn
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = "Sheet3" Then
Sheet3.HidecmdBtn
End If
End Sub
In the worksheet module of sheet3 you have the following code
Option Explicit
Private Sub CommandButton1_Click()
' Your code goes here
' In case your code deletes the sheets you have to hide the button
HidecmdBtn
End Sub
Sub HidecmdBtn()
Dim Sh As CommandButton
' My button is located on sheet 3 and has the name "CommandButton1"
Set Sh = CommandButton1
Dim sh1Name As String
Dim sh2Name As String
sh1Name = "Sheet4"
sh2Name = "Sheet5"
If SheetExists(sh1Name) Or SheetExists(sh2Name) Then
Sh.Visible = msoTrue
Else
Sh.Visible = msoFalse
End If
End Sub
In a normal module you have
Public Function SheetExists(SheetName As String, Optional wrkBook As Workbook) As Boolean
If wrkBook Is Nothing Then
Set wrkBook = ActiveWorkbook 'or ThisWorkbook - whichever appropriate
End If
Dim obj As Object
On Error GoTo HandleError
Set obj = wrkBook.Sheets(SheetName)
SheetExists = True
Exit Function
HandleError:
SheetExists = False
End Function

VBA Trying to make WorkSheet_Change work on multiple sheets but not all

I need to make a Worksheet_Change that checks for the change of values in 2 different cells in 2 different sheets. However I have more than 2 sheets and don't want to use a Workbook_Change so those other sheets are not affected.
My Code works but only checks for the cells in one worksheet but not for the other worksheet. I need to check in both worksheets.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M9")) Is Nothing Then
Application.EnableEvents = False
Application.ScreenUpdating = False
Call Macro5
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
If Not Intersect(Target, Range("I88")) Is Nothing Then
Application.EnableEvents = False
Application.ScreenUpdating = False
Call Macro6
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub
Thanks.
In the Workbook's code module you can access events triggered on any Worksheet.
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
If (Not Intersect(Target, Range("M9")) Is Nothing) Then
Call Macro5
ElseIf (Not Intersect(Target, Range("M9")) Is Nothing) Then
Call Macro6
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
If you need to know what worksheet the event fired on you can use the ByVal Sh As Object parameter.
If Sh.Name = "Sheet1" then
If you want to access the Sh object's properties using intellisense, cast Sh back from a Object back into a WorkSheet Object
Dim ws as WorkSheet
Set ws = Sh
The Private command restricts your subroutine to the current worksheet, so you're correct in using that command to keep the subroutine from altering all of your sheets.
Like newguy said, the simplest fix is to place the code in each of the worksheet modules you want it to alter, each using the Private command.

How do I improve my short VBA code as below?

I tried to protect cells on my workbook from being edited. I wrote this code,
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End Sub
But after some tests, I caught an exception. If I cut a cell and paste to another cell, it's ALLOWED! I'm not sure if there are other exceptions like this that I haven't figured out. My question is how do I protect cells being edited but meanwhile able to be copied?
Use the interface only option, this allows the sheet to be locked - but only for user interactions. Any code can interact with the sheet without being blocked:
Private Sub Workbook_Open()
For Each ws In ThisWorkbook.Sheets
ws.Protect UserInterfaceOnly:=True
Next
End Sub
without protecting the sheets the only solution I can think of is:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Application.CutCopyMode = 2 Then Application.CutCopyMode = 0
End Sub
Should be self-explaining ;)
or runn all sheets like:
Sub protectAllSheets()
Dim x As Variant
For Each x In ThisWorkbook.Sheets
x.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Next
End Sub

how can I have every excel workbook I open to have columns.autofit property?

I would like to write a macro or adjust Excel properties, so that whenever I open a new excel workbook all values are autofited to the columns.
I tried using the following code, which works if I save the code for a specific workbook, however if I save the code in the PERSONAL workbook, the code produces an error. "Method 'Columns' of object '_Global' failed"
Sub auto_open()
Columns().AutoFit
End Sub
The way I do this is to create a simple add-in that handles Application events I want to intercept. The reason that it doesn't work in the auto_open() is because you are trying to work with the Columns object before it gets instantiated. Much better to use the SheetActivate event. This also avoids the possibility of opening a Workbook with 20 pages and having to wait for all of them to AutoFit. You only see the active sheet, right?
The concept is to grab a reference WithEvents to the application and set up handlers to whatever events you care about. To do this, you'll have to put the code into a class. I called mine "AppHolder".
Class code:
Option Explicit
Private WithEvents app As Application
Private Sub Class_Initialize()
Set app = Application
End Sub
Private Sub app_SheetActivate(ByVal Sh As Object)
Sh.Columns().AutoFit
End Sub
Private Sub app_WorkbookActivate(ByVal Wb As Workbook)
Wb.ActiveSheet.Columns().AutoFit
End Sub
Private Sub app_WorkbookNewSheet(ByVal Wb As Workbook, ByVal Sh As Object)
Sh.Columns().AutoFit
End Sub
Then, create an instance of your class in and set it in auto_open (or Workbook_Open as the case may be) in the ThisWorkbook module:
Option Explicit
Private hook As AppHolder
Private Sub Workbook_Open()
Set hook = New AppHolder
End Sub
Save it as an Excel add-in file (.xlam) in the default location - should be in Users[You]\AppData\Roaming\Microsoft\AddIns. Close Excel and re-open it, then go to Developer...Add-Ins and enable it. All there is to it.
EDIT: Almost forgot - that doesn't cover all situations in which you'll be presented with a Worksheet. You need WorkbookActivate and WorkbookNewSheet too...
You could use something like this: (untested)
Sub auto_open()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim wb As Workbook
Dim ws As Worksheet
For Each wb In Workbooks
For Each ws In wb.Worksheets
ws.Columns.AutoFit
Next ws
Next wb
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Its important to identify the Objects you are working on (in this case workbooks and worksheets) because it helps you to know which method you could apply to them (see)
This might work :
Sub auto_open()
For i = 1 To Application.Workbooks.Count
For j = 1 To Application.Workbooks(i).Sheets.Count
For k = 1 To Application.Workbooks(i).Sheets(j).Cells(1, Columns.Count).End(xlToLeft).Column
Application.Workbooks(i).Sheets(j).Columns(k).EntireColumn.AutoFit
Next k
Next j
Application.Workbooks(i).Save
Next i
End Sub

Re-setting all option buttons at once

I have written a code for re-setting all option button on one click but its giving an error, "object doesnt support the property or matter".
Sub Add_New_Record()
Dim i As Integer
For i = 1 To 30
With Sheets("Form")
'-- unlock the worksheet
.Unprotect
.OptionButton(i).Value = False
'-- lock the worksheet
'.Protect
.Activate
.Range("Q12").Select
End With
Next i
End Sub
Can anyone please suggest me how to fix the code and make the value of all option buttons "false" at one.
I know how to do it individually like:
Sub Add_New_Record()
With Sheets("Form")
'-- unlock the worksheet
.Unprotect
.OptionButton1.Value = False
'-- lock the worksheet
'.Protect
.Activate
.Range("Q12").Select
End With
End Sub
but since I have too many buttons, the code will get really long and inefficient.
Thanks for your help and time.
First, the With statement should be before the For loop. And it should be .OptionButtons. Try this one.
Sub Add_New_Record()
Dim i As Integer
With Sheets("Form")
.Unprotect
For i = 1 To 30
.OptionButtons(i).Value = False
Next i
.Protect
End With
End Sub
Loop through all the OLEObjects on a particular sheet and if it is an optionbutton then set it to false.
For i = 1 To ActiveSheet.OLEObjects.Count
If TypeName(ActiveSheet.OLEObjects(i).Object) = "OptionButton" Then
ActiveSheet.OLEObjects(i).Object = False
End If
Next i
Embedding this snippet in your code:
Sub Add_New_Record()
With Sheets(1)
.Unprotect
For i = 1 To .OLEObjects.Count
If TypeName(.OLEObjects(i).Object) = "OptionButton" Then
.OLEObjects(i).Object = False
End If
Next i
.Protect
.Range("Q12").Select
End With
End Sub
Read more about OLEObjects here