Excel - UDF Function 根据条件从多个工作表中获取 SUM 值

Question

I have a UDF function, which works similar to Sumifs, but with more complexed way, it sums the value based on criteria in the main sheet and lookup the value in another sheets.

The challenge i am facing is, if i enter the udf function in "C" column it lookup the value in sheet "ALPHA", instead of sheet "BETA" and same issue in other columns.

How to setup the code to refer other sheets if i enter UDF inn other columns within the code?

if the UDF function entered in the columns then the below following should be

Column A - ALPHA
Column C - BETA Column E - GAMMA

currently i have the below code

Set wks = Sheets("ALPHA")      
lr = wks.Range("I" & Rows.Count).End(xlUp).Row
arr = wks.Range("A2", "I" & lr)

Public Function ASUM(r As Range) As Double
Application.Volatile
Dim val1, val2, my_sum
Dim i, x, mylen, lr
Dim crit1, crit2, crit3, crit4, crit5, crit6, crit7, crit8, mystring, 
mystring2
Dim T1, T2, T3, T4, T5, T6, T7, T8
Dim arr
Dim wks
Dim c
Dim e

T1 = 26
T2 = T1 + 1
T3 = T1 + 2
T4 = T1 + 3
T5 = T1 + 4
T6 = T1 + 5
T7 = T1 + 6
T8 = T1 + 7

If InStr(1, r.Offset(, T1), ".") > 0 Then
mylen = Len(r.Offset(, T1))
For x = 1 To mylen
If IsNumeric(Mid(r.Offset(, T1), x, 1)) Then
mystring = mystring & Mid(r.Offset(, T1), x, 1)
Else
mystring = mystring & " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1) * 100
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " ")) & "99"
For i = val1 To val2
crit1 = crit1 & i & " "
Next
ElseIf InStr(1, r.Offset(, T1), ",") > 0 Then
crit1 = Replace(r.Offset(, T1), ",", " ")
Else
crit1 = r.Offset(, T1).Value
End If
mystring = "": mystring2 = ""

If InStr(1, r.Offset(, T2), ".") > 0 Then
mylen = Len(r.Offset(, T2))
For x = 1 To mylen
If IsNumeric(Mid(r.Offset(, T2), x, 1)) Then
mystring = mystring & Mid(r.Offset(, T2), x, 1)
Else
mystring = mystring & " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1)
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " "))
For i = val1 To val2
crit2 = crit2 & i & " "
Next
ElseIf InStr(1, r.Offset(, T2), ",") > 0 Then
crit2 = Replace(r.Offset(, T2), ",", " ")
Else
crit2 = r.Offset(, T2).Value
End If
mystring = "": mystring2 = ""

If InStr(1, r.Offset(, T3), ".") > 0 Then
mylen = Len(r.Offset(, T3))
For x = 1 To mylen
If IsNumeric(Mid(r.Offset(, T3), x, 1)) Then
mystring = mystring & Mid(r.Offset(, T3), x, 1)
Else
mystring = mystring & " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1)
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " "))
For i = val1 To val2
crit3 = crit3 & i & " "
Next
ElseIf InStr(1, r.Offset(, T3), ",") > 0 Then
crit3 = Replace(r.Offset(, T3), ",", " ")
Else
crit3 = r.Offset(, T3).Value
End If
mystring = "": mystring2 = ""

If InStr(1, r.Offset(, T4), ".") > 0 Then
mylen = Len(r.Offset(, T4))
For x = 1 To mylen
If IsNumeric(Mid(r.Offset(, T4), x, 1)) Then
mystring = mystring & Mid(r.Offset(, T4), x, 1)
Else
mystring = mystring & " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1)
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " "))
For i = val1 To val2
crit4 = crit4 & i & " "
Next
ElseIf InStr(1, r.Offset(, T4), ",") > 0 Then
crit4 = Replace(r.Offset(, T4), ",", " ")
Else
crit4 = r.Offset(, T4).Value
End If
mystring = "": mystring2 = ""

If InStr(1, r.Offset(, T5), ".") > 0 Then
mylen = Len(r.Offset(, T5))
For x = 1 To mylen
If IsNumeric(Mid(r.Offset(, T5), x, 1)) Then
mystring = mystring & Mid(r.Offset(, T5), x, 1)
Else
mystring = mystring & " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1)
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " "))
For i = val1 To val2
crit5 = crit5 & i & " "
Next
ElseIf InStr(1, r.Offset(, T5), ",") > 0 Then
crit5 = Replace(r.Offset(, T5), ",", " ")
Else
crit5 = r.Offset(, T5).Value
End If
mystring = "": mystring2 = ""

If InStr(1, r.Offset(, T6), ".") > 0 Then
mylen = Len(r.Offset(, T6))
For x = 1 To mylen
If IsNumeric(Mid(r.Offset(, T6), x, 1)) Then
mystring = mystring & Mid(r.Offset(, T6), x, 1)
Else
mystring = mystring & " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1)
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " "))
For i = val1 To val2
crit6 = crit6 & i & " "
Next
ElseIf InStr(1, r.Offset(, T6), ",") > 0 Then
crit6 = Replace(r.Offset(, T6), ",", " ")
Else
crit6 = r.Offset(, T6).Value
End If
mystring = "": mystring2 = ""
.............................................
If InStr(1, r.Offset(, T7), ".") > 0 Then
mylen = Len(r.Offset(, T7))
For x = 1 To mylen
If IsNumeric(Mid(r.Offset(, T7), x, 1)) Then
mystring = mystring & Mid(r.Offset(, T7), x, 1)
Else
mystring = mystring & " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1)
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " "))
For i = val1 To val2
crit7 = crit7 & i & " "
Next
ElseIf InStr(1, r.Offset(, T7), ",") > 0 Then
crit7 = Replace(r.Offset(, T7), ",", " ")
Else
crit7 = r.Offset(, T7).Value
End If
mystring = "": mystring2 = ""

If InStr(1, r.Offset(, T8), ".") > 0 Then
mylen = Len(r.Offset(, T8))
For x = 1 To mylen
If IsNumeric(Mid(r.Offset(, T8), x, 1)) Then
mystring = mystring & Mid(r.Offset(, T8), x, 1)
Else
mystring = mystring & " "
End If
Next
mystring2 = Trim(mystring)
val1 = Left(mystring2, InStr(1, mystring2, " ") - 1)
val2 = Right(mystring2, Len(mystring2) - InStr(1, mystring2, " "))
For i = val1 To val2
crit8 = crit8 & i & " "
Next
ElseIf InStr(1, r.Offset(, T8), ",") > 0 Then
crit8 = Replace(r.Offset(, T8), ",", " ")
Else
crit8 = r.Offset(, T8).Value
End If

Set wks = Sheets("ALPHA")

lr = wks.Range("I" & Rows.Count).End(xlUp).Row
arr = wks.Range("A2", "I" & lr)

For i = 1 To UBound(arr)
If InStr(1, crit1, arr(i, 1)) > 0 Or r.Offset(, T1) = "" Or r.Offset(, T1) = "<ALL>" Then
If InStr(1, crit2, arr(i, 2)) > 0 Or r.Offset(, T2) = "" Or r.Offset(, T2) = "<ALL>" Then
If InStr(1, crit3, arr(i, 3)) > 0 Or r.Offset(, T3) = "" Or r.Offset(, T3) = "<ALL>" Then
If InStr(1, crit4, arr(i, 4)) > 0 Or r.Offset(, T4) = "" Or r.Offset(, T4) = "<ALL>" Then
If InStr(1, crit5, arr(i, 5)) > 0 Or r.Offset(, T5) = "" Or r.Offset(, T5) = "<ALL>" Then
If InStr(1, crit6, arr(i, 6)) > 0 Or r.Offset(, T6) = "" Or r.Offset(, T6) = "<ALL>" Then
If InStr(1, crit7, arr(i, 7)) > 0 Or r.Offset(, T7) = "" Or r.Offset(, T7) = "<ALL>" Then
If InStr(1, crit8, arr(i, 8)) > 0 Or r.Offset(, T8) = "" Or r.Offset(, T8) = "<ALL>" Then
my_sum = my_sum + arr(i, UBound(arr, 2))
End If
End If
End If
End If
End If
End If
End If
End If
Next
ASUM = my_sum
End Function

Answer 1

It turns out that a UDF can get information about the cell it gets called from using Application.Caller :

Dim kaller As Range, n As Long
Set kaller = Application.Caller
 n = kaller.Column
 If n = 1 Then Set ws = Sheets("ALHPA")
 If n = 3 Then Set ws = Sheets("BETA")
 If n = 5 Then Set ws = Sheets("GAMMA")

this should replace the single line:

Set wks = Sheets("ALPHA")

The logic can be expanded if the UDF gets called from other columns.