I wrote the attached macro (with a lot of a lot of your help.....so thank you ). It is doing what I want it to do, but it takes over a minute for it to run when I run it on my real file which has over 4000 rows and it's a little over 1MB (in the test one with only a couple hundred rows it runs fast). I realize it's doing quite a bit, but I was wondering if there was a way to make the code more efficient.
workbook with code attached and code is below as well:
[VBA]
Sub MonthlyEnrollmentCount()
Dim numRecs As Integer
Using Select is seldom needed and will slow code execution. Use With() to make sure that a Worksheet is set once.
e.g.
[vba]With Sheets("Counts")
.Range("B1").FormulaR1C1 = "EMP"
.Range("C1").FormulaR1C1 = "EMP+DEP"
End With [/vba]
For some other speedup tips and easy to use routines, see my kb entry: http://www.vbaexpress.com/kb/getarticle.php?kb_id=1035
Yes, but that is a speedup tip. If you view my code in my speedup routine, you will notice that I turn off screen updating and calculation. You have lots of that going on.
This speeds it up 4-fold:[vba]Sub blah1()
'StartTime = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'this sped it up the most
Dim numRecs As Long
Set SourceSheet = ActiveSheet
'name sheets
SourceSheet.Name = "Monthly Enrollment"
Set CountSht = Sheets.Add(After:=Sheets(Sheets.Count))
'name ranges
With SourceSheet
.Rows("1:5").Delete
numRecs = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
With .Range("A1:A" & numRecs + 1)
.Offset(, 9).Name = "Subscribers"
.Offset(, 12).Name = "BillingLine"
.Offset(, 15).Name = "Tier"
'.Offset(, 17).Name = "Month" 'not used?
.Offset(, 21).Name = "AmountDue"
End With
.Range("W1").FormulaR1C1 = "Number of Lines"
.Range("W2").Resize(numRecs).FormulaR1C1 = "=COUNTIF(Subscribers,RC[-13])"
With .Range("A22:I22").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent5
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With .PageSetup
.PrintArea = "$A$1:$I$22"
.PrintGridlines = True
.Orientation = xlLandscape
End With
End With 'CountSht
'now back in With SourceSheet
.Select
.Range("A2").Select
ActiveWindow.FreezePanes = True
.Cells.EntireColumn.AutoFit
.Rows("1:1").AutoFilter
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
CountSht.Columns("A:I").EntireColumn.AutoFit
'MsgBox Timer - StartTime
MsgBox ("DONE")
End Sub
[/vba]A slight difference is that the named ranges are no longer dynamic, but that shouldn't matter.
If time is still a problem, it could probably be speeded up by doing all the calcualtions in-memory, by copying the source data into an array, creating another array or two in memory, then outputting them to the worksheets. The problems with that are (1) it would take some coding, (2) it would be difficult to adjust later.
Last edited by p45cal; 03-29-2011 at 04:54 PM.
Reason: a small change in the code to include two lines in the With..End With construct.
p45cal Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.
Just wondering if you need to actually use the WS formulas since is looks like you're not going to update the source data. The formulas might not be needed and you could stay with VBA
thank you all so much. turning off autocalculate sped it up the most - got it to 11.6 seconds for 8000 rows. changing the code to the way you showed it cut it to 11.2 seconds so thank you - definitely learning a lot from the coding.
Since the formulae on the Count sheet do not change at all, consider making the macro only change the defined names. Even this may not be needed if you kept (a version of) your dynamic ranges. The Count sheet should update itself. Then all you'd need to do is overwrite the values on the Monthly Enrolment sheet (and maybe copy the Count sheet to somewhere else, converting the formulae to values at the same time).
p45cal Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.
Not sure I understand what you mean......I am actually having this macro run from a different workbook on a spreadsheet that I download every month, not so much updating values once the macro is run
OK, I hadn't realised that. So are you saying that you have the above macro in a workbook and it adds a sheet to another workbook - namely the one that you download every month?
If so, following the same idea, tha attached file has only one worksheet, called Counts, (which acts as a template, containing all the formulae (mostly showing as #Name?), formatting, with a set print_area) and one macro (below) which when run, asks the user to identify the downloaded file (no checks that it's the right file and that it hasn't been processed before - as yet (also it assumes the first sheet is the source sheet)) then processes it by copying the Counts sheet to it and adding a few defined names, adding a column to the source sheet, autofilters it and freezes the panes on it.
I think you'll like the speed.
[vba]Sub blah4()
'get the target file and open it:
inputfilename = Application.GetOpenFilename("Excel,*.xls")
If inputfilename <> False Then
StartTime = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set inputfile = Workbooks.Open(inputfilename)
'now add a counts sheet to it:
With inputfile
.Sheets(1).Rows("1:5").Delete
'these names are dynamic but don't need to be, they can be defined as elsewhere:
.Names.Add Name:="Tier", RefersToR1C1:="=OFFSET('" & Sheets(1).Name & "'!R1C16,,,COUNTA('" & Sheets(1).Name & "'!C1))"
.Names.Add Name:="BillingLine", RefersToR1C1:="=OFFSET('" & Sheets(1).Name & "'!R1C13,,,COUNTA('" & Sheets(1).Name & "'!C1))"
.Names.Add Name:="AmountDue", RefersToR1C1:="=OFFSET('" & Sheets(1).Name & "'!R1C22,,,COUNTA('" & Sheets(1).Name & "'!C1))"
.Names.Add Name:="Subscribers", RefersToR1C1:="=OFFSET('" & Sheets(1).Name & "'!R1C10,,,COUNTA('" & Sheets(1).Name & "'!C1))"
.Sheets(1).Range("W1").FormulaR1C1 = "Number of Lines"
.Sheets(1).Range("W2").Resize(Range("Subscribers").Cells.Count - 1).FormulaR1C1 = "=COUNTIF(Subscribers,RC[-13])"
.Sheets(1).Name = "Monthly Enrollment"
ThisWorkbook.Sheets("Counts").Copy After:=.Sheets(1)
.Sheets("Counts").UsedRange.Formula = .Sheets("Counts").UsedRange.Formula
Application.Goto .Sheets(1).Range("A2"), True
ActiveWindow.ScrollRow = 1
ActiveWindow.FreezePanes = True
.Sheets(1).Cells.EntireColumn.AutoFit
.Sheets(1).Rows("1:1").AutoFilter
Application.Calculation = xlCalculationAutomatic
.Sheets("Counts").Columns("A:I").EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
MsgBox Timer - StartTime
'MsgBox ("DONE")
End If
'inputfile.save/saveas?
End Sub
[/vba]
p45cal Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.
yeah, so I was thinking of going that route at the beginning but then if someone goes in and changes a formula on that main sheet it will ruin it for everyone else. there are so many people who will be accessing this file that I figured it was just safer to have the macro write the formulas. (and protecting the formulas is not an option for some ridiculous political reasons)
). It is doing what I want it to do, but it takes over a minute for it to run when I run it on my real file which has over 4000 rows and it's a little over 1MB (in the test one with only a couple hundred rows it runs fast). I realize it's doing quite a bit, but I was wondering if there was a way to make the code more efficient.
14").FormulaR1C1 = "=R[-12]C+R[-10]C"
Reply With Quote
