PDA

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!