You can use these two UDF's.
ConcatIf mirrors SUMIF, with additional (optional) Delimiter and NoDuplicate arguments.
ThreeFormulas takes the result of the three arguments (formulas) and puts them in the cell, the input validation Title and the input validation Message.
In the attachment, E2 contains "North" and the formula in F2
=ThreeFormulas(SUMIF(A:A,E2,C:C), Concatif(A:A,E2,B:B,","), Concatif(A:A,E2,C:C,"+"))
puts the sum of all amounts (colC) that come from the North region (column A) in F2.
When F2 is selected, box will pop up with "Bob,Bob,Dave,Bob,Dave" as the title (the people in column B who contributed to that sum) and "10+15+8+56+12" as the message (the amounts that made up the sum).
Function ConcatIf(ByVal compareRange As Range, ByVal xCriteria As Variant, Optional ByVal stringsRange As Range, _
Optional Delimiter As String, Optional NoDuplicates As Boolean) As String
Dim i As Long, j As Long
With compareRange.Parent
Set compareRange = Application.Intersect(compareRange, Range(.UsedRange, .Range("a1")))
End With
If compareRange Is Nothing Then Exit Function
If stringsRange Is Nothing Then Set stringsRange = compareRange
Set stringsRange = compareRange.Offset(stringsRange.Row - compareRange.Row, _
stringsRange.Column - compareRange.Column)
For i = 1 To compareRange.Rows.Count
For j = 1 To compareRange.Columns.Count
If (Application.CountIf(compareRange.Cells(i, j), xCriteria) = 1) Then
If InStr(ConcatIf, Delimiter & CStr(stringsRange.Cells(i, j))) <> 0 Imp Not (NoDuplicates) Then
ConcatIf = ConcatIf & Delimiter & CStr(stringsRange.Cells(i, j))
End If
End If
Next j
Next i
ConcatIf = Mid(ConcatIf, Len(Delimiter) + 1)
End Function
Function ThreeFormulas(Formula1 As Variant, Optional Formula2 As Variant, Optional Formula3 As Variant) As Variant
Dim formulaSnip As String, val2 As String, val3 As String
Application.Volatile
With Application.Caller
formulaSnip = Mid(.Formula, 16)
With .Validation
.Delete
.Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertStop _
, Formula1:="=True", Operator:=xlBetween
.ShowInput = True
If Not IsMissing(Formula3) Then
.InputTitle = CStr(Evaluate("CHOOSE(2," & formulaSnip))
.InputMessage = CStr(Evaluate("CHOOSE(3," & formulaSnip))
ElseIf Not IsMissing(Formula2) Then
.InputMessage = CStr(Evaluate("CHOOSE(2," & formulaSnip))
End If
End With
End With
ThreeFormulas = Evaluate("CHOOSE(1," & formulaSnip)
End Function
Bookmarks