I made a small vba script in order to turn on or off screenupdating and calculation automatic.
here is my code:
Sub speed_up()
If Application.Calculation = xlAutomatic Then
Application.ScreenUpdating = False
Application.Calculation = -4135
Else
Application.ScreenUpdating = True
Application.Calculation = -4105
End If
End Sub
Regarding calculation, it's working well.
In my immediate window, when I ask
?Application.ScreenUpdating
I always get
True
Is it normal? shouldn't I get false and True alternatively?
Related
I've been googling this and couldn't find an answer, so I post it for the record, this a macro to show or hide the status bar in excel:
Sub status_bar()
' shortcut: ctrl+shift+k
If Application.DisplayStatusBar = "True" Then
Application.DisplayStatusBar = False
Else
Application.DisplayStatusBar = True
End If
End Sub
So I am attempting to hide rows in Excel 2013 using VBA based a several different conditions:
If title of section is "Unused" hide section. Each section is a named range to make this easier.
If row is part of the "Cblank" named range hide it.
Now for the hard part -- For each Cell in Range("CNonTest") if C.Value = "" and C.Columns(41).Value = "" Then hide them.
Range("CNonTest") is in Col C the extra column that should be check is Col AQ.
For added difficulty I need this macro to run every time any 1 of 8 different validation boxes changes.
Below is the code I currently have:
Sub CompHide()
With Sheets("Comparison").Cells
.EntireRow.Hidden = False
If Range("C9").Value = "Unused" Then
Range("CMarket1").EntireRow.Hidden = True
End If
If Range("C115").Value = "Unused" Then
Range("CMarket2").EntireRow.Hidden = True
End If
If Range("C221").Value = "Unused" Then
Range("CMarket3").EntireRow.Hidden = True
End If
If Range("C329").Value = "Unused" Then
Range("CMarket4").EntireRow.Hidden = True
End If
If Range("C437").Value = "Unused" Then
Range("CMarket5").EntireRow.Hidden = True
End If
If Range("C545").Value = "Unused" Then
Range("CMarket6").EntireRow.Hidden = True
End If
If Range("C653").Value = "Unused" Then
Range("CMarket7").EntireRow.Hidden = True
End If
If Range("C761").Value = "Unused" Then
Range("CMarket8").EntireRow.Hidden = True
End If
If Range("C869").Value = "Unused" Then
Range("CMarket9").EntireRow.Hidden = True
End If
If Range("C977").Value = "Unused" Then
Range("CMarket10").EntireRow.Hidden = True
End If
For Each C In Range("CNonTest")
If C.Value = "" And C.Columns(41).Value = "" Then
C.EntireRow.Hidden = True
End If
Next
Range("CBlank").EntireRow.Hidden = True
End With
End Sub
Then on the Sheet I have this code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A4")) Is Nothing _
Or _
Intersect(Target, Me.Range("D4")) Is Nothing _
Or _
Intersect(Target, Me.Range("G4")) Is Nothing _
Or _
Intersect(Target, Me.Range("K4")) Is Nothing _
Or _
Intersect(Target, Me.Range("AO4")) Is Nothing _
Or _
Intersect(Target, Me.Range("AR4")) Is Nothing _
Or _
Intersect(Target, Me.Range("AU4")) Is Nothing _
Or _
Intersect(Target, Me.Range("AY4")) Is Nothing _
Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
For the Sheet Code I have also tried this to no avail
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A4")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
If Intersect(Target, Me.Range("D4")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
If Intersect(Target, Me.Range("G4")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
If Intersect(Target, Me.Range("K4")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
If Intersect(Target, Me.Range("AO4")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
If Intersect(Target, Me.Range("AR4")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
If Intersect(Target, Me.Range("AU4")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
If Intersect(Target, Me.Range("AY4")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
Call CompHide
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
This code all seems to work fine and when I step through CompHide using F8 it works perfectly. So I am thinking the issue is from the code on the sheet itself. You will see a comment in that code that mentions to prevent endless loop that comment came from some hand me down code not quite sure what it is for but figured based on the comment I would leave it.
When I change a validation box it no longer hides the all the right things only some of them. Luckily I have not seen it hide something it was not suppose to yet. I say no longer because at first this code only looked at the first validation box but now it looks at all 8.
Some adjustments to your event handler:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
On Error GoTo haveError
Set rng = Application.Intersect(Target, Me.Range("A4,D4,G4,K4,AO4,AR4,AU4,AY4"))
If Not rng Is Nothing Then
Application.EnableEvents = False 'to prevent endless loop
Application.ScreenUpdating = False
CompHide
Application.EnableEvents = True
End If
Exit Sub
haveError:
'always re-enable events
' (screenupdating setting is not persistent)...
Application.EnableEvents = True
End Sub
and the other part:
Sub CompHide()
Dim sht As Worksheet, C As Range
Set sht = Sheets("Comparison")
sht.Rows.Hidden = False
SetRowVis "C9", "CMarket1"
SetRowVis "C115", "CMarket2"
'...and the rest
For Each C In sht.Range("CNonTest")
If C.Value = "" And C.EntireRow.Columns(43).Value = "" Then
C.EntireRow.Hidden = True
End If
Next
sht.Range("CBlank").EntireRow.Hidden = True
End Sub
'utility sub...
Sub SetRowVis(addr As String, rngName As String)
With Sheets("Comparison")
If .Range(addr).Value = "Unused" Then
.Range(rngName).EntireRow.Hidden = True
End If
End With
End Sub
1st, you have referencing issue on your CompHide Sub.
You need to fully reference all Range object call to the worksheet.
With Sheets("Comparison")
.Cells.EntireRow.Hidden = False
'Notice the dot in front of the Range object
If .Range("C9").Value = "Unused" Then .Range("CMarket1").EntireRow.Hidden = True
'Also notice that I used a one liner IF which I think is applicable for you
'Rest of your code go here
'.
'.
'.
End With
2nd, take a look on Tim's post. He beats me to it. :)
I have written the below code to cycle through my worksheets as a kind of slideshow to use in a sales department. The code works perfectly when I step through in debug mode, however when I run the macro it only works intermittently, occasionally getting to the selecting of the worksheets without having reactivated the screen updating application function.
Here is the code I have created so far:
Sub Runshow()
Dim ws As Worksheet
On Error GoTo exit_
Application.EnableCancelKey = xlErrorHandler
For Each ws In ThisWorkbook.Worksheets
ws.Protect
Next
Application.DisplayFullScreen = True
Application.DisplayFormulaBar = False
ActiveWindow.DisplayWorkbookTabs = False
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHorizontalScrollBar = False
ActiveWindow.DisplayVerticalScrollBar = False
Application.Calculation = xlManual
Let y = 0
Do Until y = 80
Application.ScreenUpdating = False
Workbooks.Open("c:\users\admin\downloads\crm.xlsx").Activate
Application.Calculate
ActiveWorkbook.Close savechanges = False
Application.ScreenUpdating = True
ThisWorkbook.Activate
Let x = 0
Do Until x = 23
For Each ws In ActiveWorkbook.Worksheets
ws.Select
Application.Wait (Now + TimeValue("00:00:10"))
x = x + 1
Next
Loop
y = y + 1
Loop
exit_:
For Each ws In ThisWorkbook.Worksheets
ws.Unprotect
Next
Application.DisplayFullScreen = False
Application.DisplayFormulaBar = True
ActiveWindow.DisplayWorkbookTabs = True
ActiveWindow.DisplayGridlines = True
ActiveWindow.DisplayHorizontalScrollBar = True
ActiveWindow.DisplayVerticalScrollBar = True
Application.Calculation = xlAutomatic
End Sub
I put together some simple code that does something similar, and works well. You can build out from here - ask any questions if there's anything you don't understand.
Sub Slideshow()
Dim ws As Worksheet
PrepareView True
For Each ws In ThisWorkbook.Worksheets
ws.Activate
Application.Wait (Now + TimeValue("00:00:10"))
Next ws
PrepareView False
End Sub
Function PrepareView(status As Boolean)
If status = True Then
ActiveWindow.DisplayWorkbookTabs = False
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHorizontalScrollBar = False
ActiveWindow.DisplayVerticalScrollBar = False
ElseIf status = False Then
Application.DisplayFullScreen = False
Application.DisplayFormulaBar = True
ActiveWindow.DisplayWorkbookTabs = True
ActiveWindow.DisplayGridlines = True
ActiveWindow.DisplayHorizontalScrollBar = True
ActiveWindow.DisplayVerticalScrollBar = True
End If
End Function
This is my first post, so if I need to make any changes, please let me know.
I've found a few examples of ways to optimize loops, but I cannot seem to apply any of them effectively to my code. What I'm trying to do is loop through about 170 cells in a single column, and hide or show the entire row based on whether the cell value is 0 or not.
I want the code to run each time I activate certain sheets. Right now this piece of code is taking about 4 seconds to run. It seems like it should be much faster than that! That's why I'm here for help.
Here is the code I'm using (FormatSheet returns a BOOLEAN where True means that it is okay to perform this code on this sheet and False means to skip performing this code on this sheet:
Private Sub mobjWb_SheetActivate(ByVal Sh As Object)
Dim r As Long
Dim z As Long
Dim varray As Variant
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
If Not FormatSheet(Sh) Then
Exit Sub
End If
Set varray = Range("$F$1", Cells(Rows.count, "F").End(x1up)).Value
For Each r In varray
z = r.Value
If z = 0 Then
Range("F" & r).EntireRow.Hidden = True
Else
Range("F" & r).EntireRow.Hidden = False
End If
Next r
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub
With several very slight changes:
Sub qwerty()
Dim r As Range
Dim z As Long, N As Long
Dim varray As Range
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
N = Cells(Rows.Count, "F").End(xlUp).Row
Set varray = Range("F1:F" & N)
For Each r In varray
z = r.Value
If z = 0 Then
r.EntireRow.Hidden = True
Else
r.EntireRow.Hidden = False
End If
Next r
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
End Sub
run quite rapidly
One thing that may speed up it a little bit.. I would not use z variable. You can do the same with existing r.
For Each r In varray
If r.Value = 0 Then
Range("F" & r).EntireRow.Hidden = True
Else
Range("F" & r).EntireRow.Hidden = False
End If
Next r
I think the quickest way could be to use autofilter. Set the autofilter with values <> 0 and voilà!
I've been researching how to speed up my code in Excel VBA and I've come across the following settings which have been helpful. My question is: is it possible to set the following lines of code into one variable that I can set to On or Off to activate the entire list? I.e. something like
speedUpCode = On
would set all of the below settings and if it were set to Off it would reverse all of the below to True/xlCalculationAutomatic
With Application
.ScreenUpdating = False
.DisplayStatusBar = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
ActiveSheet.DisplayPageBreaks = False 'note this is a sheet-level setting
I use this (very basic):
Sub GoFast(Optional bYesNo As Boolean = True)
With Application
.ScreenUpdating = Not bYesNo
.Calculation = IIf(bYesNo, xlCalculationManual, xlCalculationAutomatic)
End With
End Sub
Call with True or no parameter to speed things up, then with False to reset.
The comments above about about possibly capturing the current state of the various settings so you can get back to the "original" state, and that not all settings are always appropriate to update depending on exactly what you're doing are all worth considering.
You can use a function to do this like so ...
Function speedUpCode(sStatus As String)
If sStatus = "On" Then
With Application
.ScreenUpdating = False
.DisplayStatusBar = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
ActiveSheet.DisplayPageBreaks = False 'note this is a sheet-level setting
Else if sStatus = "Off" then
With Application
.ScreenUpdating = True
.DisplayStatusBar = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
ActiveSheet.DisplayPageBreaks = True 'note this is a sheet-level setting
End Function
you can then use these to turn on and off
speedUpCode "On"
speedUpCode "Off"
However, keep in mind that you are turning settings on and off - you should probably check the status of these before changing them so that you can reset them to the original setting rather then just turning them all off again
you could does this with static variables