Re: VBA Efficiency Question
From: Tushar Mehta (tmUnderscore200310_at_tushar-mehta.SeeOhEm)
Date: 03/26/05
- Next message: Bob Phillips: "Re: Help Clear Function"
- Previous message: CLR: "Re: formatting based on text"
- In reply to: Brian: "VBA Efficiency Question"
- Next in thread: Tom Ogilvy: "Re: VBA Efficiency Question"
- Messages sorted by: [ date ] [ thread ]
Date: Sat, 26 Mar 2005 10:28:54 -0500
Two things stand out...other than the micro-improvements that have
already been pointed out to you.
First, the inner loop is a waste of resources. After the first time
through you know which columns are relevant. Why find them over and
over again?
Second, by keeping the argument as a range, but not using any of XL's
built in methods, you are 'bouncing' back and forth between VB code and
the XL worksheet with (almost) every statement in your code. Either
leverage the XL object model (use the Find method) or convert the range
to a 2D array -- the easiest way would be to declare Ref as Ref() as
double.
The code below leaves the Ref as a range. It searches an array about
1400x30 in a flash. The code has been lightly tested.
Option Explicit
Option Base 0
'This code uses arrays. While more work, they should be faster _
than a collection.
Function getValidElements(ByVal x As Double, aRng As Range) _
As Long()
'aRng should be a 1 column or a 1 row range; expect it to _
be the first column or the first row of the 2D range _
being searched
Dim Rslt() As Long, Cell1 As Range, CurrCell As Range, _
i As Long, SearchingCols As Boolean
SearchingCols = aRng.Columns.Count > 1
ReDim Rslt(aRng.Cells.Count - 2)
'Expect the first cell (intersection of the first row _
and first column) to be empty; hence the -2
Set Cell1 = aRng.Find(x, LookIn:=xlValues, LookAt:=xlWhole)
If Cell1 Is Nothing Then Exit Function
i = 0: Set CurrCell = Cell1
Do
Set CurrCell = aRng.Find(x, CurrCell, _
LookIn:=xlValues, LookAt:=xlWhole)
Rslt(i) = IIf(SearchingCols, CurrCell.Column, _
CurrCell.Row): i = i + 1
Loop Until Cell1.Address = CurrCell.Address
If i = 0 Then
Exit Function
Else
ReDim Preserve Rslt(i - 1)
getValidElements = Rslt()
End If
End Function
Function TableSum(ByVal RowValue As Double, _
ByVal ColValue As Double, Ref As Range) As Double
Dim ValidRows() As Long, ValidCols() As Long, _
i As Long, j As Long
ValidRows = getValidElements(RowValue, _
Application.WorksheetFunction.Index(Ref, 0, 1))
ValidCols = getValidElements(ColValue, _
Application.WorksheetFunction.Index(Ref, 1, 0))
For i = LBound(ValidRows) To UBound(ValidRows)
For j = LBound(ValidCols) To UBound(ValidCols)
TableSum = TableSum + Ref(ValidRows(i) - Ref.Row + 1, _
ValidCols(j) - Ref.Column + 1).Value
Next j
Next i
End Function
-- Regards, Tushar Mehta www.tushar-mehta.com Excel, PowerPoint, and VBA add-ins, tutorials Custom MS Office productivity solutions In article <7AA0D069-A0E6-47E0-A11D-B2ACCCE0E086@microsoft.com>, Brian@discussions.microsoft.com says... > The function below works perfectly, but it is very slow for large tables. I > can obviously achieve the same result more efficiently with an array formula, > but the syntax of this function is more intuitive and much easier for my > end-users to utilize. Any thoughts on how to speed up this function? Thanks. > > Function TableSum(ByVal RowValue, ByVal ColumnValue, Ref As Range) As Double > Dim x, y As Long > For y = 2 To Ref.Rows.Count > If Ref(y, 1) = RowValue Then > For x = 2 To Ref.Columns.Count > If Ref(1, x) = ColumnValue Then > TableSum = TableSum + Ref(y, x) > End If > Next x > End If > Next y > End Function >
- Next message: Bob Phillips: "Re: Help Clear Function"
- Previous message: CLR: "Re: formatting based on text"
- In reply to: Brian: "VBA Efficiency Question"
- Next in thread: Tom Ogilvy: "Re: VBA Efficiency Question"
- Messages sorted by: [ date ] [ thread ]
Relevant Pages
|
