I am using a worksheet change function to give my excel spread sheet the illusion of a search bar with a drop down box containing the results of the text in the search bar.
before I just had the hide rows part of my code which would hide and then unhide some rows in my spread sheet containing the results. that worked fine but the results would sometimes be slow and not always show up until I re calculated them.
so I added calculate to the ranges and this unfortunately slows the whole thing down substantially. Is there a better way to do this?
Private Sub Worksheet_Change(ByVal target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
If Range("D11").Value <> "" Then
Dim xlpassword As String
xlpassword = "Perry2012"
ActiveSheet.Unprotect xlpassword
ActiveSheet.EnableCalculation = False
ActiveSheet.EnableCalculation = True
Worksheets("HOME").Range("A1").Calculate
Worksheets("HOME").Range("D33").Calculate
Worksheets("HOME").Range("D32").Calculate
Worksheets("HOME").Range("E33").Calculate
Worksheets("HOME").Range("E32").Calculate
Worksheets("HOME").Range("F33").Calculate
Worksheets("HOME").Range("F32").Calculate
Worksheets("HOME").Range("G33").Calculate
Worksheets("HOME").Range("G32").Calculate
Worksheets("HOME").Range("H33").Calculate
Worksheets("HOME").Range("H32").Calculate
Worksheets("HOME").Range("I33").Calculate
Worksheets("HOME").Range("I32").Calculate
Worksheets("HOME").Range("J33").Calculate
Worksheets("HOME").Range("J32").Calculate
Worksheets("HOME").Range("K33").Calculate
Worksheets("HOME").Range("K32").Calculate
Worksheets("HOME").Range("L33").Calculate
Worksheets("HOME").Range("L32").Calculate
Worksheets("HOME").Range("M33").Calculate
Worksheets("HOME").Range("M32").Calculate
Worksheets("HOME").Range("N33").Calculate
Worksheets("HOME").Range("N32").Calculate
Worksheets("HOME").Range("O33").Calculate
Worksheets("HOME").Range("O32").Calculate
Worksheets("HOME").Range("P33").Calculate
Worksheets("HOME").Range("P32").Calculate
Worksheets("HOME").Range("Q33").Calculate
Worksheets("HOME").Range("Q32").Calculate
Worksheets("HOME").Range("R33").Calculate
Worksheets("HOME").Range("R32").Calculate
Worksheets("HOME").Range("S33").Calculate
Worksheets("HOME").Range("S32").Calculate
Worksheets("HOME").Range("T33").Calculate
Worksheets("HOME").Range("T32").Calculate
Worksheets("HOME").Range("U33").Calculate
Worksheets("HOME").Range("U32").Calculate
Worksheets("HOME").Range("V33").Calculate
Worksheets("HOME").Range("V32").Calculate
Worksheets("HOME").Range("W33").Calculate
Worksheets("HOME").Range("W32").Calculate
Worksheets("HOME").Range("D15").Calculate
Worksheets("HOME").Range("D17").Calculate
Worksheets("HOME").Range("D19").Calculate
Worksheets("HOME").Range("D21").Calculate
Worksheets("HOME").Range("D23").Calculate
Worksheets("HOME").Range("D25").Calculate
Worksheets("HOME").Range("D27").Calculate
Worksheets("HOME").Range("M15").Calculate
Worksheets("HOME").Range("M17").Calculate
Worksheets("HOME").Range("M19").Calculate
Worksheets("HOME").Range("M21").Calculate
Worksheets("HOME").Range("M23").Calculate
Worksheets("HOME").Range("M25").Calculate
Worksheets("HOME").Range("M27").Calculate
Worksheets("HOME").Range("T15").Calculate
Worksheets("HOME").Range("T17").Calculate
Worksheets("HOME").Range("T19").Calculate
Worksheets("HOME").Range("T21").Calculate
Worksheets("HOME").Range("T23").Calculate
Worksheets("HOME").Range("T25").Calculate
Worksheets("HOME").Range("T27").Calculate
Rows("15:28").Hidden = False
Rows("34:36").Hidden = True
Else
Rows("15:28").Hidden = True
Rows("34:36").Hidden = False
ActiveSheet.Protect xlpassword
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Would replacing all those separate lines by just one work:
Application.Calculate
it might be the case that you have some volatile functions heavily used in the workbook(i.e. TODAY()), which I reckon will make all formulas based on them re-calculate on each of those calculation lines in your code
Related
Very Basic I am sure but I can't figure it out for the life of me.
I have a set of radio buttons that changes the value of cell("L37") between 1 and 2.
I have tried to write the VBA code several different ways without luck. Please advise.
Sub hide_sheet()
If Worksheets("Feedback").Range("L37").Value = 1 Then
Rows("63:93").EntireRow.Hidden = True
Else Worksheets("Feedback").Range("L37").Value = 2 Then
Worksheets("Feedback").Rows("63:93").EntireRow.Hidden = False
End If
End Sub
I had it working perfectly fine via a Macro tied to the radio buttons; however, due to me needing to protect the sheet I needed to change it.
I am using a protect/unprotect VBA code and would like to include it into the code so it won't set off the macro/sheet protected warning.
Here is my protect/unprotect code I am using for everything.
Sub unprotect()
Worksheets("Feedback").unprotect
End Sub
Sub protect()
Worksheets("Feedback").protect , _
AllowFormattingCells:=True, _
AllowFormattingRows:=True
End Sub
Any advice would be greatly appreciated. I Thank You in Advance of your assistance.
Show/Hide Rows
Issues
The Feedback worksheet is not qualified so if the wrong workbook is active, it will fail. To reference the workbook containing this code, you can use ThisWorkbook:
ThisWorkbook.Worksheets("Feedback")...
You are using Rows("63:93") instead of Worksheets("Feedback").Rows("63:93") in the If clause. If the wrong worksheet is active (selected), it will fail.
You are using Else instead of ElseIf.
You can use the With statement to reduce typing as illustrated in the following code.
If you convert the cell value to a string, then if the cell accidentally contains an error value, the code will not fail.
The Code
Sub ShowHideRowsFix()
With ThisWorkbook.Worksheets("Feedback")
.Unprotect
Select Case CStr(.Range("L37").Value)
Case "1"
.Rows("63:93").Hidden = True
Case "2"
.Rows("63:93").Hidden = False
Case Else
End Select
.Protect AllowFormattingCells:=True, AllowFormattingRows:=True
End With
End Sub
An Improvement
To automate this operation (no need for buttons), in the sheet module of the Feedback worksheet identified in the VBE Project explorer window by e.g. Sheet1(FeedBack) (double-click to open), you could use the following code.
Private Sub Worksheet_Change(ByVal Target As Range)
Const CellAddress As String = "L37"
Dim Cell As Range: Set Cell = Me.Range(CellAddress)
If Intersect(Cell, Target) Is Nothing Then Exit Sub
ShowHideRows Cell
End Sub
Sub ShowHideRows(ByVal Cell As Range)
With Cell.Worksheet
.Unprotect
Select Case CStr(Cell.Value)
Case "1"
.Rows("63:93").Hidden = True
Case "2"
.Rows("63:93").Hidden = False
Case Else
End Select
.Protect AllowFormattingCells:=True, AllowFormattingRows:=True
End With
End Sub
I prefer the simplest approach where possible. This is the approach I use to hide columns re-written for your needs.
The following code may exist on the UserForm or in a standard Code Module:
Sub rwControl(ByRef hType As String)
Dim rwVis As Boolean
If hType = "hRW" Then rwVis = True
If hType = "uRW" Then rwVis = False
With ThisWorkbook.Worksheets("Feedback")
.Unprotect
.Rows("63:93").Hidden = rwVis
.Protect
End With
End Sub
You may call this code directly from you RadioButton_Change() Event vy including the following code:
IF RadioButton1.Value = True then 'Assuming the value is 1
rwControl "hRW" 'This hides the Rows
ELSE
rwControl "uRW" 'This unhides the Rows
End If
OR, to keep it really simple:
in your RadioButton_Change() event simply add:
Private Sub RadioButton1 Change()
With ThisWorkBook.Worksheets("Feedback")
.Unprotect
If RadioButton1.Value = True Then
.Rows("63:93").Hidden = True
Else
.Rows("63:93").Hidden = False
End If
.Protect
End With
End Sub
Using this approach negates the need for Worksheet Module Coding and Case Coding and allows you to keep the RadioButtons if you deem them important to the functionality.
My goal is to be able to have a drop down list that hides certain non-contiguous rows in excel based off the name of the individual in the list I create. I have this code which I found off Youtube and was wondering what was wrong with it as it was not working. I am relatively new to VBA
Private Sub Worksheet_Calculate()
Dim Andrew, Robert, Michael As Range
Set Andrew = Range("K30")
Set Robert = Range("K30")
Set Michael= Range ("K30")
Select Case Andrew
Case Is = "Andrew": Rows("8:10").EntireRow.Hidden = True
Rows("11:12").EntireRow.Hidden = False
Rows("13:13").EntireRow.Hidden = True
Rows("14:25").EntireRow.Hidden = False
End Select
Select Case Robert
Case Is = "Robert"
Rows("6:20").EntireRow.Hidden = True
Rows("21:25").EntireRow.Hidden = False
End Select
Select Case Michael
Case Is = "Michael"
Rows("1:5").EntireRow.Hidden = True
Rows("6:25").EntireRow.Hidden = False
End Select
End Sub
I created a dummy test Excel worksheet and inserted your VBA code into a new module. It worked fine for me, albeit is a bit clunky.
Some suggestions to help:
Always set Option Explicit at the top of your module, because this means any undeclared variables and other little things like that get picked up immediately. It's good practice to get into that habit early when starting out with VBA.
Always qualify your .Range statement with the prefix for the specific workbook/worksheet your code needs to work on. This may be why it isn't working for you, but ran fine for me. As it stands, your code will only run on whatever worksheet happens to be active at the time.
You have made this a Private Sub (private subroutine). If you have done the proverbial copy & paste then this subroutine will not show up in your list of macros, which could be another reason you cannot run it. I highly recommend you have a read of this ExcelOffTheGrid article, which breaks down the different types nicely. If you have inserted this into the Worksheet object of your VBA Project, then it may need to be moved into its own Module.
You have assigned three different names (Andrew, Robert, Michael) to the same .Range reference. This shouldn't really be allowed (although weirdly didn't flag an error when I copied your code) because what it is saying is that those text strings - and they could be anything, not just those names - all refer to the same specific cell on your worksheet. This hasn't affected your code, because you don't actually refer to them later on. In your Select Case logical tests you have used double quotes " " around each name, telling VBA it is a string of characters not a variable you have defined.
I would suggest something like this:
COPY & PASTE INTO A NEW MODULE
Option Explicit
'
'
Sub HideRows()
' This macro will hide specific non-contiguous rows based upon criteria in my drop down combo box.
'
Dim wkMyBook As Workbook
Dim wsMainSheet As Worksheet
Dim rName As Range
'
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Set wkMyBook = ActiveWorkbook
Set wsMainSheet = wkMyBook.Sheets("ENTER SHEET NAME HERE")
Set rName = wsMainSheet.Range("K30")
Select Case rName
Case Is = "Andrew"
wsMainSheet.Rows("8:10").EntireRow.Hidden = True
wsMainSheet.Rows("11:12").EntireRow.Hidden = False
wsMainSheet.Rows("13:13").EntireRow.Hidden = True
wsMainSheet.Rows("14:25").EntireRow.Hidden = False
Case Is = "Robert"
wsMainSheet.Rows("6:20").EntireRow.Hidden = True
wsMainSheet.Rows("21:25").EntireRow.Hidden = False
Case Is = "Michael"
wsMainSheet.Rows("1:5").EntireRow.Hidden = True
wsMainSheet.Rows("6:25").EntireRow.Hidden = False
End Select
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
COPY & PASTE INTO THE WORKBOOK OBJECT
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' This code will run whenever a change is made to your worksheet
If Target.Address = "$K$30" Then
Select Case Target.Value
Case Is = "Andrew", "Robert", "Michael"
Call HideRows
End Select
End If
End Sub
This has bought your ticket, given you the lift, dropped you off right at the door. Now you gotta do that final step to put this together to make it work. Read the article I linked, learn about bit about how VBA is constructed and then next time you should be a bit further along the path before you need a pick up. Good luck!
Drop Down Worksheet Change
When you change a value in a cell via 'drop down', the Worksheet.Change event is triggered.
Copy the first code into the appropriate sheet module e.g. Sheet1.
Copy the second code into a standard module, e.g. Module1.
You do not run anything, it is automatically showing or hiding rows.
Sheet1
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const RangeAddress As String = "K30"
If Not Intersect(Target, Me.Range(RangeAddress)) Is Nothing Then
manipulateRows Me, Target.Value
End If
End Sub
Module1
Option Explicit
Sub manipulateRows(Sheet As Worksheet, checkString As String)
With Sheet
Select Case checkString
Case "Andrew"
.Rows("8:10").Hidden = True
.Rows(13).Hidden = True
.Rows("11:12").Hidden = False
.Rows("14:25").Hidden = False
Case "Michael"
.Rows("1:5").Hidden = True
.Rows("6:25").Hidden = False
Case "Robert"
.Rows("6:20").Hidden = True
.Rows("21:25").Hidden = False
Case Else ' When DEL is pressed (Empty Cell), shows all rows.
.Rows("1:25").Hidden = False
End Select
End With
End Sub
In a large project I add a large number of shapes at different positions in a Worksheet. Furthermore, I insert a number of rows.
I want the shapes to move with the inserted rows. However, they only do so with Application.ScreenUpdating = True. As soon as ScreenUpdating is set False, the shapes stop moving. This of course messes up the results completely.
I cannot reproduce the problem. In this minimal example, the inserted shapes move as expected with the inserted row, although I use Application.ScreenUpdating = False. In my larger program the basically identical procedure fails without ScreenUdating.
Sub ShapeTest()
Dim ActiveShape As Shape
Dim ShapeCell As Range
Application.ScreenUpdating = False
Set ShapeCell = ActiveSheet.Range("A1")
Set ActiveShape = ActiveSheet.Shapes.AddShape(msoShapeRectangle, ShapeCell.Left, ShapeCell.Top, ShapeCell.Width, ShapeCell.Height)
ActiveSheet.Rows(1).Insert shift:=xlShiftDown
Application.ScreenUpdating = True
End Sub
Update
I have tried DoEvents before and after inserting the row, but it didn't change anything. Currently I am using this workaround:
Application.ScreenUpdating = True
Worksheets("Gantt").Rows(ThisRowGTT).Insert shift:=xlShiftDown
Application.ScreenUpdating = False
This slows down the execution alot - almost as if I would use ScreenUpdating for the entire program.
I'm new to VBA and have been trying to write a code that hides and unhides rows based on the input value of a certain cell address. However, it doesn't work and I don't why. I have posted my code below:
Sub Hide()
If Worksheets("IS").Range("B8").Value = "Show All" Then
Worksheets("IS").Rows("12:165").EntireRow.Hidden = False
End If
If Worksheets("IS").Range("B8").Value = "Just Revenue" Then
Worksheets("IS").Rows("12:165").EntireRow.Hidden = False
Worksheets("IS").Rows("28:165").EntireRow.Hidden = True
End If
If Worksheets("IS").Range("B8").Value = "Just Expenses" Then
Worksheets("IS").Rows("12:165").EntireRow.Hidden = False
Worksheets("IS").Rows("12:27").EntireRow.Hidden = True
Worksheets("IS").Rows("160:165").EntireRow.Hidden = True
End If
If Worksheets("IS").Range("B8").Value = "Just Cogs" Then
Worksheets("IS").Rows("12:165").EntireRow.Hidden = False
Worksheets("IS").Rows("12:27").EntireRow.Hidden = True
Worksheets("IS").Rows("64:165").EntireRow.Hidden = True
End If
If Worksheets("IS").Range("B8").Value = "Just Totals" Then
Worksheets("IS").Rows("12:165").EntireRow.Hidden = False
Worksheets("IS").Rows("12:25").EntireRow.Hidden = True
Worksheets("IS").Rows("28:61").EntireRow.Hidden = True
Worksheets("IS").Rows("64:91").EntireRow.Hidden = True
Worksheets("IS").Rows("93:155").EntireRow.Hidden = True
End If
End Sub
Any help with why my code doesn't work or any tips to improve it would be much appreciative.
Rewriting for Worksheet_Change:
In your VBE, paste this code into the code sheet for the "IS" worksheet (double click it in the Project - VBAProject pane. If the Project - VBAProject pane is not visible in your VBE, go to View>>Project Explorer):
Private Sub Worksheet_Change(ByVal Target As Range)
'Ensure that we don't trigger another change event while this code is running
Application.EnableEvents = False
'Check if cell B8 triggered this change:
If Not Intersect(Target, Range("B8")) Is Nothing Then
'B8 changed... which means B8 is "Target" variable
Select Case Target.Value
Case "Show All"
Worksheets("IS").Rows("12:165").EntireRow.Hidden = False
Case "Just Revenue"
Worksheets("IS").Rows("12:165").EntireRow.Hidden = False
Worksheets("IS").Rows("28:165").EntireRow.Hidden = True
Case "Just Expenses"
Worksheets("IS").Rows("12:165").EntireRow.Hidden = False
Worksheets("IS").Rows("12:27").EntireRow.Hidden = True
Worksheets("IS").Rows("160:165").EntireRow.Hidden = True
Case "Just Cogs"
Worksheets("IS").Rows("12:165").EntireRow.Hidden = False
Worksheets("IS").Rows("12:27").EntireRow.Hidden = True
Worksheets("IS").Rows("64:165").EntireRow.Hidden = True
Case "Just Totals"
Worksheets("IS").Rows("12:165").EntireRow.Hidden = False
Worksheets("IS").Rows("12:25").EntireRow.Hidden = True
Worksheets("IS").Rows("28:61").EntireRow.Hidden = True
Worksheets("IS").Rows("64:91").EntireRow.Hidden = True
Worksheets("IS").Rows("93:155").EntireRow.Hidden = True
End Select
End If
'Turn events back on so this code triggers again
Application.EnableEvents = True
End Sub
There are quite a few events that we can hook VBA to (SelectionChange, DoubleClick, Workbook_Close, etc). In this case we are hooking to Worksheet_Change().
This code gets triggered every time this worksheet experiences a change. The Target variable will hold the range that triggered the event. So we test to see if that Target intersects with Range("B8") which means B8 was changed. Then we perform the code inside the If block.
I switched your If/ElseIf over to a Select/Case just because it makes for cleaner code since we are testing a single condition (the value of B8) over and over again.
In this code we also toggle off the Excel Applications EnableEvents feature. This feature is what allowed this Worksheet_Change() to get triggered in the first place. Often times in the code we make more changes to the worksheet (hiding rows or columns, for instance) which will trigger the application to run Worksheet_Change() again... while it's running Worksheet_Change() already. This can cause code to run superfluously and, often, cause an endless loop that makes excel crash.
This code needs to be pasted on the sheet where you want are wanting to execute the code. You will not need to qualify your ranges with the sheets once the code is there as well.
You can just refer directly to your range without the Worksheets("IS"). as so:
Rows("so and so").EntireRow.Hidden = True
You can also just refer to your TargetRange by variable now like so:
If MyTarget = "Just Revenue" Then
I inserted one of your conditions in the code as an example
Option Explicit
Private Sub worksheet_change(ByVal target As Range)
Dim MyTarget As Range
Set MyTarget = Range("B8")
If Not Intersect(target, MyTarget) Is Nothing Then
Application.EnableEvents = False
'Your CODE HERE
If MyTarget = "Show All" Then
Rows("12:165").EntireRow.Hidden = False
End If
Application.EnableEvents = True
End If
End Sub
I am using the following vba codes which im using to hide a set of rows and unhide rows depending on if a cell contains text or not, and they are causing my excel spreadsheet to be slow and unresponsive and causing the egg timer to show for about 10 seconds.
If I take the code out It speeds things up so what can I do to my codes to get them to speed up and not take so long? perhaps there is a better way of structuring the code but im really new to vba so am not sure what I would need to do, would appreciate someone's help thanks.
the reason I am using worksheet change and worksheet selection change is so that whether a user clicks on a cell or not the page still updates
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("K22").Value <> "" Then
Application.ScreenUpdating = False
Rows("25:38").EntireRow.Hidden = False
Rows("40:48").EntireRow.Hidden = True
ElseIf Range("K22").Value = "" Then
Rows("25:38").EntireRow.Hidden = True
Rows("40:48").EntireRow.Hidden = False
End If
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("K22").Value <> "" Then
Application.ScreenUpdating = False
Rows("25:38").EntireRow.Hidden = False
Rows("40:48").EntireRow.Hidden = True
ElseIf Range("K22").Value = "" Then
Rows("25:38").EntireRow.Hidden = True
Rows("40:48").EntireRow.Hidden = False
End If
Application.ScreenUpdating = True
End Sub
The main issue is from the Worksheet_Change event, but it could be applied to any event.
The worksheet change is triggering each time you hide a column, so it's trying several times to hide the same columns, before (eventually) failing with an out of memory error:
Hide these columns... Oh, a worksheet change... Hide these columns... Oh, A worksheet change... Hide th...
To avoid this, you need to use
Application.EnableEvents = False
when you decide you are going to make changes, and
Application.EnableEvents = True
when done.
You may also want to put some error handling that turns the events on again, as if something else occurs that stops the code from running, the triggers will be turned off, and the spreadsheet will no longer update as you expect it to.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
If Range("K22").Value <> "" Then
Rows("25:38").Hidden = False
Rows("40:48").Hidden = True
Else
Rows("25:38").Hidden = True
Rows("40:48").Hidden = False
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
This works instantly for me:
Application.ScreenUpdating = False
Select Case Range("K22")
Case Is <> ""
Rows("25:38").Hidden = False
Rows("40:48").Hidden = True
Case Else
Rows("25:38").Hidden = True
Rows("40:48").Hidden = False
End Select
Application.ScreenUpdating = True