View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Tushar Mehta Tushar Mehta is offline
external usenet poster
 
Posts: 1,071
Default VBA Efficiency Question

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 ,
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