View Full Version : Calculation Speed
chocho
02-06-2013, 07:31 PM
I'm fairly new to vba, so: If I wanted to z score lots of data (4 mil cells), it is taking quite long. I currently use the code (ThisWorkbook.numofcolumns + 2 contains average for each row, +3 st dev for each row):
Set NumRNG = .UsedRange.SpecialCells(xlConstants, 1)
NumRNG.FormulaR1C1 = "=(('Sheet1'!RC-'Sheet1'!RC" & ThisWorkbook.numofcolumns + 2 & ")/'Sheet1'!RC" & ThisWorkbook.numofcolumns + 3
Would it be faster to load the spreadsheet into an array and perform the function on the array? And if so, how would I do this? Or is there another way to prevent the bottleneck? Thanks in advance!
Bob Phillips
02-07-2013, 02:41 AM
According to Charles Williams, it looks like there is a limit on arrays of circa 500MB for 32-bit VBA, and 4GB for 64-bit VBA (Excel 2010-64).
So your 4 million cells, even as longs, should be well within either of those limits.
Looking at the formula suggests that the calculations are not that intensive, just a lot of them. How would you envisage doing them from the array? If you used a loop, that might negate any advantages the array gives.
I just filled 4M cells with your formula, and even on my slow little netbook, it only took 1257 ms, that seems perfectly acceptable to me.
chocho
02-07-2013, 10:04 AM
You're right, that is completely acceptable. However when I take that one step out of my vba it is about 30s faster. It also takes a while to delete that sheet with the Z scores (on order of 5 seconds). I'm posting the full macro, maybe someone can spot another issue:
Option Explicit
Dim shNM As String, NR As Long
Sub Analysis()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Percent = 0.03
With Progress
.FrameProgress.Caption = Format(Percent, "0%")
.LabelProgress.Width = Percent * (.FrameProgress.Width - 10)
End With
DoEvents
.UsedRange.Copy
End With
'Process genetic data
With ThisWorkbook.Worksheets("Gene Expression")
shNM = "'" & .Name & "'"
.Copy After:=Sheets(Sheets.Count)
.Cells(1, ThisWorkbook.numofcolumns + 2) = "Average"
.Cells(1, ThisWorkbook.numofcolumns + 3) = "SD"
.Cells(2, ThisWorkbook.numofcolumns + 2).Resize(ThisWorkbook.numofrows + 1, 1).FormulaR1C1 = "=AVERAGE(RC[-1]:RC2)"
.Cells(2, ThisWorkbook.numofcolumns + 3).Resize(ThisWorkbook.numofrows + 1, 1).FormulaR1C1 = "=STDEV(RC[-2]:RC2)"
End With
ThisWorkbook.Worksheets("Gene Expression (2)").Name = "Z score"
Application.Calculation = xlCalculationManual
With ThisWorkbook.Worksheets("Z score")
Set NumRNG = .UsedRange.SpecialCells(xlConstants, 1)
Dim i As Long
For i = 2 To ThisWorkbook.numofcolumns + 1
.Range(.Cells(2, i), .Cells(ThisWorkbook.numofrows + 1, i)).FormulaR1C1 = "=(('Gene Expression'!RC-'Gene Expression'!RC" & ThisWorkbook.numofcolumns + 2 & ")/'Gene Expression'!RC" & ThisWorkbook.numofcolumns + 3 & "*'Patient Weighting'!R5C)"
Percent = (i + 50) / (ThisWorkbook.numofcolumns + 200)
With Progress
.FrameProgress.Caption = Format(Percent, "0%")
.LabelProgress.Width = Percent * (.FrameProgress.Width - 10)
End With
DoEvents
Next i
.Cells(2, ThisWorkbook.numofcolumns + 2).Resize(ThisWorkbook.numofrows, 1).FormulaR1C1 = "=SUM(RC[-1]:RC2)"
.Cells(1, ThisWorkbook.numofcolumns + 2) = "Sums"
End With
Percent = 0.8
With Progress
.FrameProgress.Caption = Format(Percent, "0%")
.LabelProgress.Width = Percent * (.FrameProgress.Width - 10)
End With
DoEvents
Worksheets.Add
ActiveSheet.Name = "Gene Scores"
Set NumRNG = ThisWorkbook.Worksheets("Z score").UsedRange
With ThisWorkbook.Worksheets("Gene Scores")
.Range(.Cells(1, 1), .Cells(ThisWorkbook.numofrows + 1, ThisWorkbook.numofcolumns + 2)).Value = NumRNG.Value
Percent = 0.9
With Progress
.FrameProgress.Caption = Format(Percent, "0%")
.LabelProgress.Width = Percent * (.FrameProgress.Width - 10)
End With
DoEvents
Application.DisplayAlerts = False
Sheets("Z score").Delete
Sheets("Gene Expression").Delete
Application.DisplayAlerts = True
End With
Percent = 0.95
With Progress
.FrameProgress.Caption = Format(Percent, "0%")
.LabelProgress.Width = Percent * (.FrameProgress.Width - 10)
End With
DoEvents
'Create the signature worksheet
Worksheets.Add
shNM = "Signature (" & ThisWorkbook.SignatureNumber & ")"
ActiveSheet.Name = shNM
ThisWorkbook.SignatureNumber = ThisWorkbook.SignatureNumber + 1
With ThisWorkbook.Worksheets(shNM)
.Range("A1") = "Upregulated Genes"
.Range("B1") = "Downregulated Genes"
For i = 1 To ThisWorkbook.SignatureSize / 2
.Cells(i + 1, 1) = ThisWorkbook.Worksheets("Gene Scores").Cells(i + 1, 1)
.Cells(i + 1, 2) = ThisWorkbook.Worksheets("Gene Scores").Cells(ThisWorkbook.numofrows + 2 - i, 1)
Next i
End With
'Delete all remaining worksheets.
Application.DisplayAlerts = False
For Each ws In Worksheets
If ws.Name <> shNM Then ws.Delete
Next
Application.ScreenUpdating = True
End Sub
Kenneth Hobs
02-07-2013, 11:26 AM
Does disabling events help?
Here is my speedup routine. http://vbaexpress.com/kb/getarticle.php?kb_id=1035
chocho
02-07-2013, 02:57 PM
Helped a little, thanks!
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.