VlookupAllSum=SUMPRODUCT

[Spielmann]

Hi Colleagues,

I behind developed to a time a function of Addition with an only conditional criterion.
I would like to extend at least for three criteria, this function I function accurately as the function SUMPRODUCT alone that done in VBA.
Somebody could help me to develop?

Debtor

Function VlookupAllSum(name As String, IntervalSearches As Range, IntervalReturn As Range) As Variant ' as integer para valores até 32.767
Dim Valor, Nome
Dim lin, col As Integer
Dim Total
Application.Volatile
lin = 1
col = lin
For Each Nome In IntervalSearches
If Nome = name Then
Valor = IntervalReturn(lin, col)
Total = Total + Valor
VlookupAllSum = Total
End If
lin = lin + 1
Next Nome
VlookupAllSum = Total
End Function

Ex:=VlookupAllSum(A1,A1:A6,C1:C6)=33
=SUMPRODUCT(--(A1:A6=A1),(--(C1:C6)))

=VlookupAllSum(A4,A1:A6,C1:C6)=54
=SUMPRODUCT(--(A1:A6=A4),(--(C1:C6)))
A----------------B-------C
<TABLE style="WIDTH: 144pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=192 border=0 x:str><COLGROUP><COL style="WIDTH: 48pt" span=3 width=64><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 48pt; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" width=64 height=17>A</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 48pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right width=64 x:num>1</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 48pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right width=64 x:num>10</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>A</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num>2</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num>11</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>A</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num>3</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num>12</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>B</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num>1</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num>15</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>B</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num>2</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num>19</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>B</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num>3</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num>20</TD></TR></TBODY></TABLE>


Spielmann .^.

 

[Spielmann]

Gettingbetter,
It was accurately this that I needed, but the function locks when trying to rewrite.
It would be to ask for very, to correct this imperfection.
It was very better of what it imagined, therefore still appears transcribed with the SUMPRODUCT
Thanks a lot….ray:
Spielmann

 

[Spielmann]

I obtained to develop following the line of reasoning in VBA and disponibilizo the function of Addition with multiple criteria, that is with three criteria and the interval of addition.
Debtor to all.

Function VlookupAllSum(IntervalReturn As Range, name As Variant, IntervalSearches As Range, Optional name2 As Variant, Optional IntervalSearches2 As Range, Optional name3 As Variant, Optional IntervalSearches3 As Range) As Double
Dim rngSearch As Range, dblSoma As Double, strFirstAddress As String, blCálculo As Boolean, blAutorização As Boolean
If Not IntervalSearches2 Is Nothing Then
If Not IntervalSearches3 Is Nothing Then
If IntervalReturn.Columns.Count = 1 Or IntervalSearches.Columns.Count = 1 Or IntervalSearches2.Columns.Count = 1 Or IntervalSearches3.Columns.Count = 1 Then
If IntervalReturn.Cells.Count = IntervalSearches.Cells.Count And IntervalReturn.Cells.Count = IntervalSearches2.Cells.Count And IntervalReturn.Cells.Count = IntervalSearches3.Cells.Count Then
blAutorização = True
End If
End If
Else
If IntervalReturn.Columns.Count = 1 Or IntervalSearches.Columns.Count = 1 Or IntervalSearches2.Columns.Count = 1 Then
If IntervalReturn.Cells.Count = IntervalSearches.Cells.Count And IntervalReturn.Cells.Count = IntervalSearches2.Cells.Count Then
blAutorização = True
End If
End If
End If
Else
If IntervalReturn.Columns.Count = 1 Then
If IntervalReturn.Cells.Count = IntervalSearches.Cells.Count Then
blAutorização = True
End If
End If
End If

If blAutorização Then

Set rngSearch = IntervalSearches.Find(name, , , xlWhole)

If Not rngSearch Is Nothing Then
strFirstAddress = rngSearch.Address
Do
If Not IntervalSearches2 Is Nothing Then
If name2 = IntervalSearches2(rngSearch.Row - IntervalSearches.Row + 1) Then
blCálculo = True
If Not IntervalSearches3 Is Nothing Then
If name3 = IntervalSearches3(rngSearch.Row - IntervalSearches.Row + 1) Then
blCálculo = True
Else
blCálculo = False
End If
End If
End If
Else
blCálculo = True
End If
If blCálculo Then
dblSoma = dblSoma + IntervalReturn(rngSearch.Row - IntervalReturn.Row + 1)
blCálculo = False
End If
Set rngSearch = IntervalSearches.Find(name, rngSearch, , xlWhole)
Loop While Not rngSearch Is Nothing And rngSearch.Address <> strFirstAddress
End If
VlookupAllSum = dblSoma
Set rngSearch = Nothing
Else
Error 11
End If
End Function


Debtor to all.

 

[Spielmann]

I need to make a adjustment in the function increasing for plus a name and an interval of search

Somebody can help me, please?

add: Optional nome4 As Variant, Optional IntervaloProcura4 As Range

Function ProcvMultiSoma(IntervaloSoma As Range, nome As Variant, IntervaloProcura As Range, Optional nome2 As Variant, Optional IntervaloProcura2 As Range, Optional nome3 As Variant, Optional IntervaloProcura3 As Range) As Double<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o> </o>
Dim rngSearch As Range, dblSoma As Double, strFirstAddress As String, blCálculo As Boolean, blAutorização As Boolean<o></o>
<o> </o>
If Not IntervaloProcura2 Is Nothing Then<o></o>
If Not IntervaloProcura3 Is Nothing Then<o></o>
If IntervaloSoma.Columns.Count = 1 Or IntervaloProcura.Columns.Count = 1 Or IntervaloProcura2.Columns.Count = 1 Or IntervaloProcura3.Columns.Count = 1 Then<o></o>
If IntervaloSoma.Cells.Count = IntervaloProcura.Cells.Count And IntervaloSoma.Cells.Count = IntervaloProcura2.Cells.Count And IntervaloSoma.Cells.Count = IntervaloProcura3.Cells.Count Then<o></o>
blAutorização = True<o></o>
End If<o></o>
End If<o></o>
Else<o></o>
If IntervaloSoma.Columns.Count = 1 Or IntervaloProcura.Columns.Count = 1 Or IntervaloProcura2.Columns.Count = 1 Then<o></o>
If IntervaloSoma.Cells.Count = IntervaloProcura.Cells.Count And IntervaloSoma.Cells.Count = IntervaloProcura2.Cells.Count Then<o></o>
blAutorização = True<o></o>
End If<o></o>
End If<o></o>
End If<o></o>
Else<o></o>
If IntervaloSoma.Columns.Count = 1 Then<o></o>
If IntervaloSoma.Cells.Count = IntervaloProcura.Cells.Count Then<o></o>
blAutorização = True<o></o>
End If<o></o>
End If<o></o>
End If<o></o>
<o></o>
If blAutorização Then<o></o>
<o></o>
Set rngSearch = IntervaloProcura.Find(nome, , , xlWhole)<o></o>
<o></o>
If Not rngSearch Is Nothing Then<o></o>
strFirstAddress = rngSearch.Address<o></o>
Do<o></o>
If Not IntervaloProcura2 Is Nothing Then<o></o>
If nome2 = IntervaloProcura2(rngSearch.Row - IntervaloProcura.Row + 1) Then<o></o>
blCálculo = True<o></o>
If Not IntervaloProcura3 Is Nothing Then<o></o>
If nome3 = IntervaloProcura3(rngSearch.Row - IntervaloProcura.Row + 1) Then<o></o>
blCálculo = True<o></o>
Else<o></o>
blCálculo = False<o></o>
End If<o></o>
End If<o></o>
End If<o></o>
Else<o></o>
blCálculo = True<o></o>
End If<o></o>
If blCálculo Then<o></o>
dblSoma = dblSoma + IntervaloSoma(rngSearch.Row - IntervaloSoma.Row + 1)<o></o>
blCálculo = False<o></o>
End If<o></o>
Set rngSearch = IntervaloProcura.Find(nome, rngSearch, , xlWhole)<o></o>
Loop While Not rngSearch Is Nothing And rngSearch.Address <> strFirstAddress<o></o>
End If<o></o>
ProcvMultiSoma = dblSoma<o></o>
Set rngSearch = Nothing<o></o>
Else<o></o>
Error 11<o></o>
End If<o></o>
End Function<o></o>