I have the following code:
Application.ScreenUpdating = false
Set rng = Application.Selection.Range
For i = 0 To 25000
ActiveDocument.Fields.Add rng, WdFieldType.wdFieldExpression, "1+2", False
Next i
Application.ScreenUpdating = true
Is there a way to further increase its performance?
(Noticed that if I would hide the application Application.Visible = false its faster but I don't really want do that)
(The amount is an edge case, but I would still like to make it plausible and currently, it's taking around 30 minutes to complete, which no user will wait)
Related
Thanks in advance for your help. I have been working on this for a few days now and have tried a few different options. What I need done is to hide specific rows of an excel sheet based on the contents of an active X dropdown. I have indexed the dropdown to a cell and every time the user changes the dropdown selection, the indexed cell contains their selection as either text or number (whichever makes it easiest to code - I've been trying both). I want to keep the code as close to how it is at the moment if possible. I'm sure there are shorter/ more convenient methods, but I just want this over. I think the issue is that when the user selects a new option from the dropdown, the macro isnt refreshing and showing ALL rows again before it begins to hide the new rows. As a result, I just end up with a whole bunch of hidden rows based on what was originally selected. I hope that makes sense.
See the code below for what I've already tried. I also tried this one too, but had the same issue (that the macro wasnt refreshing and showing ALL rows before applying another Hide function)
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Activate
If Not Application.Intersect(Range("U13"), Range(Target.Address)) Is Nothing Then
Select Case Target.Value
Case Is = "Brand Health": Rows("19:39").EntireRow.Hidden = True
Rows("40:60").EntireRow.Hidden = False
Case Is = "Brand Imagery": Rows("38:60").EntireRow.Hidden = True
Rows("61:81").EntireRow.Hidden = False
Case Is = "NPS": Rows("30:82").EntireRow.Hidden = True
Rows("83:102").EntireRow.Hidden = False
Case Is = "Talent": Rows("35:103").EntireRow.Hidden = True
Rows("104:126").EntireRow.Hidden = False
Case Is = "Shows": Rows("37:127").EntireRow.Hidden = True
Rows("128:148").EntireRow.Hidden = False
End Select
End If
End Sub
Private Sub Worksheet_Change(ByVal Target`enter code here` As Range)
Sheets("Brand Tracking Dashboard").Rows("1:1000").EntireRow.Hidden = False ' Move this to the top
If Target.Address = ("$U$13") And Target.Value = 1 Then
Sheets("Brand Tracking Dashboard").Rows("19:39").EntireRow.Hidden = True
Sheets("Brand Tracking Dashboard").Rows("59:1000").EntireRow.Hidden = True
ElseIf Target.Address = ("$u$13") And Target.Value = 2 Then
Sheets("Brand Tracking Dashboard").Rows("43:63").EntireRow.Hidden = True
Sheets("Brand Tracking Dashboard").Rows("80:1000").EntireRow.Hidden = True
ElseIf Target.Address = ("$u$13") And Target.Value = 3 Then
Sheets("Brand Tracking Dashboard").Rows("32:84").EntireRow.Hidden = True
Sheets("Brand Tracking Dashboard").Rows("101:1000").EntireRow.Hidden = True
ElseIf Target.Address = ("$u$13") And Target.Value = 4 Then
Sheets("Brand Tracking Dashboard").Rows("37:106").EntireRow.Hidden = True
Sheets("Brand Tracking Dashboard").Rows("121:1000").EntireRow.Hidden = True
ElseIf Target.Address = ("$u$13") And Target.Value = 5 Then
Sheets("Brand Tracking Dashboard").Rows("37:129").EntireRow.Hidden = True
Sheets("Brand Tracking Dashboard").Rows("145:1000").EntireRow.Hidden = True
End If
End Sub
What should happen is that after the user makes a selection, I guess the logic should be that the sheet is told to show ALL rows before applying the hide line command.
You are almost there - your guess was right. You just need to unhide all the rows before you hide the right ones based on the selection.
The first sub you posted is trying to do some unhiding, but it's only unhiding a few rows - and as you can't control what order the user selects the values in, it's probably trying to unhide the wrong ones. (Work through what happens if a user selects "Brand Health" followed by "Shows").
Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
On Error GoTo errHandler
Application.ScreenUpdating = False
Set ws = Target.Worksheet
If Not Application.Intersect(ws.Range("U13"), Range(Target.Address)) Is Nothing Then
ws.Rows("19:148").Hidden = False 'edit this to include all the rows that could be hidden
Select Case Range("U13").Value
Case Is = "Brand Health"
ws.Rows("19:39").Hidden = True
Case Is = "Brand Imagery"
ws.Rows("38:60").Hidden = True
Case Is = "NPS"
ws.Rows("30:82").Hidden = True
Case Is = "Talent"
ws.Rows("35:103").Hidden = True
Case Is = "Shows"
ws.Rows("37:127").Hidden = True
End Select
End If
Application.ScreenUpdating = True
Exit Sub
errHandler:
Application.ScreenUpdating = True
End Sub
I've made a few other improvements:
ActiveSheet.Activate wasn't doing anything
You shouldn't rely on a particular sheet being the active one - what if the user changes it halfway through your macro? So I get the right worksheet at the start and use that throughout (make sure we are always working on the correct sheet)
Target could be a range of cells; you are only interested in the value of U13 so make that the condition for the Select Case
it's neater and faster to turn off screen updating - making sure it always gets turned on afterwards (even if there's an error).
Rows("xx:yy") returns whole rows so there's no need for EntireRow
I have an excel file with a VBA code (Not written by me)
How this code works is user enters a 6 digit number in a user form, the VBA then checks another sheet and if this 6 digit number is present on the worksheet.
If it does, it changes the stage, but if it doesn't it adds this 6 digit number to the worksheet
It used to work perfectly, but now because the excel file has grown in the number of rows, almost 6000 rows, this code is become very slow, takes up to 20 seconds to update the sheet
Can someone please help me speed this code up, or suggest another way to acheive it
The code is below
Private Sub cmdPSDUdate_Click()
Dim x
If (Me.PSDUDateRow = "") + (Me.PSDStageCB.ListIndex = -1) Then Exit Sub
With Sheets("psdata stage cals").ListObjects("PSDataStageCals")
x = Application.Match(Val(Me.PSDUDateRow), .ListColumns(1).DataBodyRange, 0)
If IsNumeric(x) Then
.ListRows(x).Range(2) = Me.PSDStageCB.Value
Else
.ListRows.Add.Range = Array(Val(Me.PSDUDateRow), Me.PSDStageCB)
End If
End With
Me.PSDUDateRow.Value = ""
Me.PSDStageCB.Value = ""
Me.PSDUDateRow.SetFocus
End Sub
Thanks in advance
Rahul
You could turn off screenupdating, automatic calculations etc
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
‘Place your macro code here
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
In general, there are two ways to speed up VBA code:
Write good code, that does not use Select, Activate, ActiveCell, Selection etc - How to avoid using Select in Excel VBA
Refer to these routines on the start and on the end of the code:
Public Sub OnEnd()
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
ThisWorkbook.Date1904 = False
Application.StatusBar = False
End Sub
Public Sub OnStart()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.Calculation = xlAutomatic
ThisWorkbook.Date1904 = False
ActiveWindow.View = xlNormalView
End Sub
(For improvement ideas, kindly make PullRequest)
I think that Calculation should be always set to xlAutomatic, as far as if you need xlCalculationManual to speed up, it is a good idea to refactor the code. Furthermore manual calculation is too risky.
The same goes for Date1904 - it is always set to False.
In addition to the tweaks suggested by Storax, your code is slow because you are bringing data cell-by-cell over the Excel/VBA divide.
Furthermore, you can radically speed up your MATCH function by using the Binary version of it. Have a read of http://dailydoseofexcel.com/archives/2015/04/23/how-much-faster-is-the-double-vlookup-trick/ and also try to minimise the amount of individual transfers you do across the Excel/VBA divide by either performing the lookups entirely within the Excel sheet (by using VBA to write the formula in the sheet and execute it there) or by bringing all the data into VBA in one go using variant arrays, performing your logic, and then by dumping it back in one go. Google "Efficient way to transfer data between Excel and VBA" or something similar. Also check out any articles from Charles Williams on the subject.
I don't see anything wrong with your code. Perhaps the Workbook itself is the culprit. Is it becoming huge and slow to open ?
If yes, try searching for 'cleanup excel file'.
Some results I found:
https://excelfilecleaner.codeplex.com/
https://support.microsoft.com/en-us/help/3070372/how-to-clean-up-an-excel-workbook-so-that-it-uses-less-memory
When crunching large chunks of data in Excel that requires frequent referencing of cells, it’s always much much faster to copy the data to an array (copy the entire worksheet if necessary), process the data within the array, and then write back to the worksheet if necessary. Copying data from worksheet to array is a one line command that is very very fast. Same with array to worksheet. Relatively speaking, referencing cells is a very time consuming process compared with referencing elements of an array.
I have this piece of code which I would like to show and hide some Shape objects one by one, in order to make a little animation. However, nothing happens as the code executes, all images are shown by once when the code stops running.
Sub test()
For i = 1 To 4
Sheets("Game").Shapes("North" & i).Visible = True
Sleep 500
'Sheets("Game").Shapes("North" & i).Visible = False
'by setting it to false i'd like to achieve the animation effect
Debug.Print i
DoEvents
Next i
End Sub
DoEvents allows other code (e.g. Excel's own) to run and handle things like user clicking on another worksheet (which invokes any Worksheet.Change or Workbook.WorksheetChange handler)... or just repainting itself.
By invoking DoEvents once per loop, Excel doesn't get a chance to repaint between the visibility toggles: it's already busy running your loop.
So you need to toggle visibility on, let Excel repaint (DoEvents), sleep for your animation delay (500ms seems a tad slow IMO), then toggle visibility off and let Excel repaint again, i.e. invoke DoEvents one more time.
If the Game worksheet is in ThisWorkbook, then I'd warmly recommend you give it a CodeName - select it in the Project Explorer, then look at its properties (F4) and change its (Name) to, say, GameSheet.
This gives you a global-scope object variable so that you don't need to dereference the same worksheet twice per iteration - heck you could even dereference its Shapes collection only once:
Private Const ANIMATION_DELAY As Long = 100
Sub test()
With GameSheet.Shapes
For i = 1 To 4
Dim currentShape As Shape
Set currentShape = .Item("North" & i)
currentShape.Visible = True
DoEvents
Sleep ANIMATION_DELAY
currentShape.Visible = False
DoEvents
Debug.Print i
Next
End With
End Sub
Amended the code by setting DoEvents after toggling True and Falseand now it works:
Sub test()
For i = 1 To 4
Sheets("Game").Shapes("North" & i).Visible = True
DoEvents
Sleep 100
Sheets("Game").Shapes("North" & i).Visible = False
DoEvents
'by setting it to false i'd like to achieve the animation effect
Debug.Print i
Next i
End Sub
I am creating an Excel Spreadsheet graph using VBA like so:-
Private Sub Chart_Calculate()
Title$ = Range("charttitle")
ActiveChart.Axes(xlCategory).Select
With ActiveChart.Axes(xlCategory)
.MinimumScale = 0
.MaximumScale = 300
.MinorUnit = 10
.MajorUnit = 50
.Crosses = xlCustom
.CrossesAt = 0
.ReversePlotOrder = True
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
End Sub
I then attempt to set the series name, like this:-
ActiveChart.SeriesCollection(1).Name = CStr(some_value) & " Some Text"
When I add this line of code to the sub, it causes the Chart_Calculate function to be activated numerous times in rapid succession, causing the graph to flicker for a few seconds before stabilising.
Does anyone know what the matter is, and what I should do about it?
(This is Excel 2003 running on Windows XP.)
EDIT: PortlandRunner's suggestion cleared up the problem during the graph redrawing, but it still exists if the Graph is visible at startup. See also this.
Try inserting Application.Calculation = xlCalculationManual at the beginning of your code, and Application.Calculation = xlCalculationAutomatic at/near the end of your code.
I have an excel vba macro that creates and formats a sales quote. I have a function that autofits merged cells. I use this function to autofit description fields as some of them are long and some are short. On a typical quote, this function is called around 40 times. The macro completes in under a second. If I run the exact same macro again (perhaps with different settings on how it will display) it takes upwards of 30-60 seconds. There's nothing in the rest of the macro that slows down with each run except for the following block:
Is there something that could be making this code run slower for the exact same set of inputs?
Sub AutoFit_Height(ByVal Target As Range)
Dim MergeWidth As Single
Dim cM As Range
Dim CWidth As Double
Dim NewRowHt As Double
With Target
.MergeCells = False
CWidth = .Cells(1).ColumnWidth
MergeWidth = 0
For Each cM In Target
cM.WrapText = True
MergeWidth = cM.ColumnWidth + MergeWidth
Next
'small adjustment to temporary width
MergeWidth = MergeWidth + Target.Cells.count * 0.66
.Cells(1).ColumnWidth = MergeWidth
.EntireRow.AutoFit
NewRowHt = .RowHeight
.Cells(1).ColumnWidth = CWidth
.MergeCells = True
.RowHeight = NewRowHt
End With
End Sub
Go to the start of the main body of code (the one that calls this subroutine) and add
Application.ScreenUpdating = False
as one of the first lines. Then at the end of that function, after this subroutine has been called, turn it back on:
Application.ScreenUpdating = True
This will keep it from redrawing the screen for every change in column/row size, resulting in a significantly faster run time.
Optimazing your script might start with
using xlsb file saving extension
look for any unecessary formatting by deleting unused rows and
columns and saving so to make the vertical and horizontal scroll bar
scroll just to the necessary data
Use named range as much as possible
This could be added to your script
At the start of the main module from where you call other modules or functions
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
At the end of the main module task is complete
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
As you are manipulating many worksheet objects that's quite a cpu intensive process. A change in algorithm could improve time needed for this process. Maybe you should post the entire code so to help you further.
Cheers,
Pascal
http://multiskillz.tekcities.com
Autofit is painfully slow for me to. The only thing I can add to any other answer here is to put it in a separate module and only call it when necessary or time is available. Also, to implement last, once all other code is tested and working.