Excuse me if duplicating, but couldn't find anything in regards to my problem on the internet.
So I have:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Then somewhere down the script there is
For Each sheet In sheets
If sheet.Cells(i, ColBrand).Rows.Hidden Then
sheet.Cells(i, ColBrand).EntireRow.Hidden = False
End If
Next
, where ColBrand is just a column number defined as a constant integer in the beginning.
And so it goes through an array of worksheets hiding rows where necessarity doing its job just fine.
Problem is, despite CalculationManual, "calculating: xx%" still pops up in a status bar occasionally. Which, alongside with the speed of execution, leads me to thinking Excel recalculates the entire Worksheet (possibly Workbook) after hiding each row. Which is sad.
Any ideas?
Thank you!
Now I'm thinking, could it be because I have a couple of VBA written Application.Volatile functions on one of the Worksheets?
I do have this function, which gets called under a condition, which triggers WorkSheet_change event. If this is of any help
Function get_rand(floor As Long, ceiling As Long, exceptions() As Long)
Dim rand As Long, _
position As Variant
If UBound(exceptions) - LBound(exceptions) + 1 >= 999999 Then
get_rand = "error"
Else
Do Until IsError(position)
rand = CLng(((ceiling - floor + 1) * Rnd() + floor))
position = Application.Match(rand, exceptions, False)
get_rand = rand
Loop
End If
End Function
Oh btw the code above interacts with sheets which have WorkSheet_Change routines themselves. Target.Adress 'es of these do partly intersect but get neither changed nor updated by the code above. Could it be the cause?
This MS Document discusses this problem.
It states "The user can trigger recalculation in Microsoft Excel in several ways, for example:" ... "Deleting or inserting a row or column."
I think you've stumbled upon a documented "feature".
Related
I have an excel table where I'm using my custom made functions, made in VBA. I have to mention that I am using these functions inside cells, not in a macro. Everything works just fine, however, I am noticing a dramatic slowdown in calculation time. To be honest, I am using my function in about 200 cells, but still I don't see how it can reason such a memory hungry spreadsheet. Also my 2 functions are very basic, one is a plain vanilla isExist(value) search in a 5 cells range (no binary or other fast search algos). The other function is a modified dateDiff, so I can use it as a cell function (for some reason dateDiff does not show as a cell formula). Anyways, can someone tell me why a vba function would be so memory hungry when used in cell as a formula, and how can I optimize this?
Function existsInArray(array_to_search As range, value_to_exist As String) As Boolean
For Each value In array_to_search
If value_to_exist = value Then
existsInArray = True
Exit Function
End If
Next
existsInArray = False
End Function
Function dayOfTheYear(begining_of_year_date As Date, to_date As Date) As Integer
dayOfTheYear = CInt(DateDiff("d", begining_of_year_date, to_date)) + 1
End Function
I can't analyze completely without seeing how the UDFs are being used, but having code loop over ranges can be very slow. For example:
Public Function MyUdf(rng As Range) As Variant
Dim r As Range
For Each r In rng
' do something that calculates MyUdf
MyUdf = 1
Next r
End Function
will examine and process each cell in rng. If the user puts something like:
=MyUdf(A:A)
in a cell, it will process every cell in the entire column.
To limit the extent of the looping, you can use something like:
Public Function MyUdf2(rng As Range) As Variant
Dim r As Range, RNG2 As Range
Set RNG2 = Intersect(rng, rng.Parent.UsedRange)
For Each r In RNG2
' do something that calculates MyUdf
MyUdf2 = 1
Next r
End Function
That way you may end up processing thousands of cells rather than millions.
Anther possible speedup technique is to create VBA arrays to process the data rather than use cells directly.
Well, by default, UDF's (User Defined Functions) in Excel VBA are not volatile. They are only recalculated when any of the function's arguments change. A volatile function will be recalculated whenever calculation occurs in any cells on the worksheet.
Turn Off Automatic Calculation
vba performanceSet the Calculation mode to xlCalculationManual so that no calculations are carried out within the Excel Workbook until the Calculation mode is changed back to xlCalculationAutomatic or by running Application.Calculate:
Application.Calculation = xlCalculationManual
Turn Off Screen Updating
vba performancePrevent Excel from updating the Excel screen until this option is changed to True:
Application.ScreenUpdating = False
The XLSB format vs. XLSM
vba performanceA known way to improve Excel VBA speed and efficiency, especially fore large Excel files, is to save your Workbooks in binary XLSB format.
First off, I'm a noob when it comes to Macros and VBA, so please forgive me if I don't make sense.
I've got an Excel spreadsheet which is basically a list of users and their mobile phone numbers and some other bits (columns A-K are currently used) and it's ordered by rows.
What I need is a way of copying the whole row if I change a cell. So if I change the username, it copies the whole row of that user to the next blank row on a second sheet.
The purpose of this is to keep an audit trail allowing us to see who's previously used a number etc.
I found this: Copy row to another sheet in excel using VBA which is working as intended, but I can't for the life of me get it to a, copy the cells to the next free row, or b, not overwrite the existing entry.
This is the code I'm using:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Range, rw As Range
For Each a In Selection.Areas
For Each rw In a.Rows
If rw.Row >= 2 Then
rw.EntireRow.Copy Sheet2.Cells(2 + (rw.Row - 2) * 3, 1)
End If
Next rw
Next a
End Sub
I'd really appreciate it if someone could help me customise it.
I'm using Excel 2010 on Win7.
Many thank in advance.
Typically the Intersect method is used to determine if the cell or cells receiving a change involve one or more columns that you are concerned with. You can add additional parameters; in this case, I've .Offset the Worksheet.UsedRange property down one row to make sure that row 1 is not involved.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(1), Me.UsedRange.Offset(1, 0)) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False 'not really necessary in this case but never a bad idea within a Worksheet_Change
Dim a As Range
For Each a In Intersect(Target, Columns(1), Me.UsedRange.Offset(1, 0))
If CBool(Len(a.Value2)) Then _
a.EntireRow.Copy _
Destination:=Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) 'not really sure this is the correct destination
Next a
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
I've included a call to disable event handling for the duration of the Worksheet_Change event macro. While this is a critical step when the Worksheet_Change modifies values, it is not really important to incorporate here. However, it does not harm and is already in place in case you want to augment the Worksheet_Change to include something like a timestamp that would change the values on the worksheet.
I have an Excel file that takes data from outside and writes it in a ListObject.
As adding rows one by one through ListRows.Add is very slow, I add the right number of empty rows to the sheet and resize the ListObject.
This works really well in Excel 2010.
With Excel 2007, it works but when the user closes the workbook or Excel, it freezes and Windows displays its crash window (asking if you want to close, restart or debug the application).
This is really annoying and doesn't look very good :).
Any idea of what I could do to prevent that?
Maybe you have a better idea to quicky ladd thousands of rows in a ListObject?
Moreover randomly (I reopen the file change nothing and execute the macro), Resize fails with an error message and Excel crashes if I stop the execution.
Here is the function that adds the empty rows, if I follow it step by step it all the ranges are correct and it does what I need.
I'm pretty sure this is this function that causes the problem as it disappears when I comment the call to that function.
Sub AddRowsToListObject(sheetName As String, myTable As ListObject, addRows As Long)
Dim i As Long
If addRows > 0 Then
Sheets(sheetName).Activate
'Add empty rows at the end
i = myTable.DataBodyRange.row + myTable.ListRows.Count
Sheets(sheetName).Range(Cells(i, 1), Cells(i + addRows - 2, 1)).EntireRow.Insert shift:=xlDown
'Offset -1 as you need to include the headers again
myTable.Resize myTable.DataBodyRange.Offset(-1, 0).Resize(myTable.ListRows.Count + addRows, myTable.ListColumns.Count)
End If
End Sub
Unfortunately I don't have Excel 2007 and cannot replicate the error described in the question. However and assuming that:
The code is not trying to add rows beyond the capacity of Excel 2007
The error is caused by the method used to add new lines to the existing ListObject
And since you are asking for an alternative method to add thousands of rows to an existing ListObject
Try the code below
Sub ListObjects_AddRows(myTable As ListObject, addRows As Long)
If addRows > 0 Then
With myTable.DataBodyRange
.Offset(.Rows.Count, 0).Resize(addRows, 1).EntireRow.Insert
With .Offset(.Rows.Count, 0).Resize(addRows, 1)
.Value = "X"
.ClearContents
End With: End With: End If
End Sub
add Application.ScreenUpdating = False right after the start of the sub
add Application.ScreenUpdating = True right before the end
If you are doing 1000s then you definitely don't need the screen refreshing each time a new line gets drawn. Change that and it will only redraw it once it is finished.
After a lot of painful testing, it looks like the problem is not in this method but in the deleting of the rows just before that :
Sub ResetListObject(myTable As ListObject)
myTable.DataBodyRange.ClearContents
If myTable.DataBodyRange.Rows.Count > 1 Then
myTable.DataBodyRange.Offset(1, 0).Resize(myTable.DataBodyRange.Rows.Count - 1, myTable.DataBodyRange.Columns.Count).EntireRow.Delete shift:=xlUp
End If
End Sub
Excel 2010 requires you to always keep 1 row when you empty the ListObject.
But Excel 2007 requires 2 rows !!
I don't know why and I can't find any information on that.
I changed my script to delete all rows except 2 and changed the function in the OP to manage that fact.
I'm trying to search a range of columns on a different worksheet, where the range is defined by two separate variables. I have successfully been able to use the same code to search a range of columns that I manually inputted, but using variables result in an error:
Run-time error '1004':
Application-defined or object-defined error
I am using the code to search a separate worksheet for the column number of the first instance of the month and then search a range beginning with that column number for the specific day.
An example of the worksheet I'm searching through:
http://i.imgur.com/ljmmGGi.png
Below is the code. Specifically, the MonthFind function has worked perfectly, but the subsequent DayFind function, which uses output from MonthFind is acting up.
Private Sub ComboBox21_Change()
Dim i As String
Dim j As String
i = "February"
j = 9
Dim MonthFind As Variant
With Sheets("Project Schedule").Range("A1:ZZ1")
Set MonthFind = .Find(i, LookAt:=xlWhole, MatchCase:=False)
End With
Dim Month1 As Integer
Dim Month2 As Integer
Month1 = MonthFind.Column
Month2 = MonthFind.Column + 12
Dim DayFind As Variant
With Sheets("Project Schedule").Range(Columns(Month1), Columns(Month2))
Set DayFind = .Find(j, LookAt:=xlWhole, MatchCase:=False)
End With
End Sub
Any help would be much appreciated, I've been trying so many different variations of this code to no avail!
Edit - Link to Excel file: https://www.dropbox.com/s/275fo0uucfeum3y/Project%20Scheduling%20SO.xlsm?dl=0
I almost gave up on this, but I found out what the problem was.
Your ComboBox_21 object has an input range (which will fill in the combobox with the selectable values) on the Inputs sheet that uses a bunch of formulas that reference the Project Schedule sheet. Whenever you do all those copy/paste functions against the range in Project Schedule that the combobox relies on, you are effectively changing the data for the dropdown box, and in turn, causing the _Change() event to fire off with every paste that effects that area.
This isn't always a problem (though in my opinion, it's causing a lot of unnecessary code execution), but there's this bit of code that is causing an issue in your AddJob1_Click() event:
Range(Sheet1.Cells(erow, 5), Sheet1.Cells(erow + 3, 10000)).ClearContents
Apparently you're not allowed to perform the Range.Find() method when the contents of the cells that the combobox rely on are being changed.
Here's some info about that, though it's not terribly helpful:
https://msdn.microsoft.com/en-us/library/office/aa221581(v=office.11).aspx
So that's the why, now how to fix it:
Defer automatic calculation until your UserForm code is finished doing whatever it needs to do.
This will ensure that you are allowed to do the Find's and referencing you need to do.
Private Sub AddJob1_Click()
' turn off automatic calculation
Application.Calculation = xlCalculationManual
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
' ... other stuff
' turn calculation back on and perform a calculate, which will fire off the ComboBox21_Change() event
Application.Calculation = xlCalculationAutomatic
Application.Calculate
Unload Me
End Sub
In Excel 2007, I have a worksheet that only contains data in a only few cells (well within one page wide/tall). For illustration, say the worksheet only contains data in cell A1. How can I use VBA to determine the number of columns that fit in a single printed page? Said another way, how can I determine the column furthest to the right in which I could add data and NOT cause an additional sheet to print. A couple of additional comments:
I am not setting a print area. If I were, then I'd just use the same
range...but I'm not.
I can't use UsedRange, because the used range is much smaller than
what actually fits in the width/height of a printed page.
I can't use ActiveWindow.VisibleRange because it isn't limited to a
single page width/height.
I've searched and searched, but cannot find a solution to accomplish this seemingly simple task. I mostly found scenarios that involved UsedRange, VisibleRange, and the print area, but those don't help me.
EDIT
Here's the final version of the function I'm using, which is a slight tweak of the selected answer.
Public Function GetLastColumnBeforeVPageBreak( _
ByRef ws As Worksheet, _
ByVal aVPageBreakNum As Long) As Long
Dim isMod As Boolean
isMod = False
On Error GoTo ErrorHandler
GetLastColumnBeforeVPageBreak = ws.VPageBreaks(aVPageBreakNum).Location.Column - 1
' If necessary, delete the last column with dummy data and reset UsedRange.
If isMod Then
ws.Cells(ws.Rows.Count, ws.Columns.Count).EntireColumn.Delete
r = ws.UsedRange.Rows.Count
End If
Exit Function
ErrorHandler:
If Err.Number = 9 Then
' Subscript out of range.
' Ensure there is more than one page by putting something in last cell.
isMod = True
ws.Cells(ws.Rows.Count, ws.Columns.Count).Value = 1
Err.Clear
Resume
Else
Err.Raise Err.Number
End If
End Function
I was sure there was a worksheet property around page breaks so I hit F2 in the IDE to open the object browser and searched on pagebreak. A little bit of F1'ing showed there is a Worksheets(1).VPageBreaks(1).Location property that returns a range object. The left side of the range aligns with the 1st vertical page break so:
LastColOnP1 = Worksheets(1).VPageBreaks(1).Location.Column - 1
will give you a variable containing the number of the last column that will print on page 1 of your 1st sheet.
Or within a procedure:
Sub FindFirstVPageBreak()
Dim LastColOnP1 As Long
With ActiveSheet
'Ensure there is more than one page by puting something in last column
.Cells(1, .Columns.Count) = 1
LastColOnP1 = .VPageBreaks(1).Location.Column - 1
'Delete the last column to allow UsedRange to be reset
.Cells(1, .Columns.Count).EntireColumn.Delete
End With
'Save to workbook to commit the reset UsedRange
If Not ActiveWorkbook.ReadOnly Then
ActiveWorkbook.Save 'assumes workbook has been saved previously.
End If
End Sub
You can use Columns(x).ColumnWidth to calculate (iif column contains data). See http://EzineArticles.com/7305778 for a much more detailed solution.