VBA Efficiency Question

[Brian]

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

 

[Fredrik Wahlgren]

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

Two things are immediately obvious to me

1) Assign the values of Ref.Rows.Count and Ref.Columns.Count to variables
and use the variables in the for loops
2) The declaration Dim x, y As Long will declare one of the variables as
long, the other as variant. I can't remember if it's the first or the
second. Anyway, you should use this kind of declaration

Dim x As Long
Dim y As Long

You end up with something like this

Function TableSum(ByVal RowValue, ByVal ColumnValue, Ref As Range) As Double
Dim x As Long
Dim y As Long
Dim RowCount As Long
Dom ColCount As long

RowCount = Ref.Rows.Count
ColCount = Ref.Columns.Count

For y = 2 To RowCount
If Ref(y, 1) = RowValue Then
For x = 2 To ColCount
If Ref(1, x) = ColumnValue Then
TableSum = TableSum + Ref(y, x)
End If
Next x
End If
Next y
End Function

Best Regards,
Fredrik

 

[Bob Phillips]

news:[email protected]...

snip[

Two things are immediately obvious to me

2) The declaration Dim x, y As Long will declare one of the variables as
long, the other as variant. I can't remember if it's the first or the
second. Anyway, you should use this kind of declaration

x is variant

 

[Tushar Mehta]

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

 

[Tom Ogilvy]

You have repeating values in both row and column labels? If not, what is the
situation?