Create UDF that works when dragged down - excel

I think I'm overlooking something simple...
My idea is to create a function in Excel that's easier to set up than the following:
=INDEX($A$1:$A$5,AGGREGATE(15,6,ROW($B$1:$B$5)/($B$1:$B$5=1),ROW(1:1)))
(see ScottCraner's comment in this answer for that function in practice)
I have created the following UDF:
Public Function findUnique(ByVal indexRange As Range, matchRange As Range, matchVal As Long)
' Trying to create a dynamic function of:
' =INDEX($A$1:$A$5,AGGREGATE(15,6,ROW($B$1:$B$5)/($B$1:$B$5=1),ROW(1:1)))
findUnique = Evaluate("=Index(" & indexRange.Address & ",AGGREGATE(15,6,Row(" & matchRange.Address & _
")/(" & matchRange.Address & "=" & matchVal & "),Row(" & ActiveCell.Row & ":" & ActiveCell.Row & ")))")
End Function
And it almost works. Except, when I drag down from the first row, the data doesn't update. I have to click into the cell to "retrigger" the function to get the correct data to show:
(Column D is that formula, entered correctly).
But, how do I get the formula to update automatically, without re-entering the cell?
I've also tried adding a fourth Variable:
Public Function findUnique(ByVal indexRange As Range, matchRange As Range, matchVal As Long, curRow as Long)
findUnique = Evaluate("=Index(" & indexRange.address & ",AGGREGATE(15,6,Row(" & matchRange.address & _
")/(" & matchRange.address & "=" & matchVal & "),Row(" & curRow & ":" & curRow & ")))")
End Function
and enter like: =findUnique($A$1:$A$5,$B$1:$B$5,1,ROW())
but it just returns a #VALUE error
(Also, how do I avoid ActiveCell.Row, as I have it drilled in to my head to avoid using Active anything...)
Thanks for any thoughts or advice!

From this SO answer, try the following ...
With Application.Caller
CallerRow = .Row
End With
findUnique = Evaluate("=Index(" & indexRange.Address & ",AGGREGATE(15,6,Row(" & matchRange.Address & _
")/(" & matchRange.Address & "=" & matchVal & "),Row(" & CallerRow & ":" & CallerRow & ")))")

Related

VBA using part of formula as a celll value

Failing againg with my project
I have formulas with variable Brand that is changed dynamically (AF Column). Basically all I want is to extract Brands into a column next (AE) to the formula column for visial convenience
For i = LBound(Brand) To UBound(Brand)
Range("AF" & i + 2).Formula = "=COUNTIFS(C:C," & RTrim(Month(Mesyaz3)) & _
",H:H,""Headphones"",F:F," & Chr(34) & Brand(i) & Chr(34) & ")"
Next i
Range("AF:AF").Sort Key1:=Range("AF2"), Order1:=xlDescending, Header:=xlYes
ActiveSheet.Range("AG2:AG8").Formula = ActiveSheet.Range("AF2:AF8").Formula
ActiveSheet.Range("AH2:AH8").Formula = ActiveSheet.Range("AF2:AF8").Formula
Dim ws As Worksheet
Set ws = Worksheets(1)
Dim j As Variant
j = Application.Match(""" & Brand(i) & """, ws.Range("AF2:AF8"))
ActiveSheet.Range("AE2").Value = Application.Index(ws.Range("AF2:AF8"), j, 0)
And I get #N/A Already lost two days for that. Would be enourmously grateful to anyone who could help.
It's not exactly clear from your question as to your desired output but here's a guess:
For i = LBound(Brand) To UBound(Brand)
Range("AF" & i + 2).Formula = "=COUNTIFS(C:C," & RTrim(Month(Mesyaz3)) & _
",H:H,""Headphones"",F:F," & Chr(34) & Brand(i) & Chr(34) & ")"
Range("AE" & i + 2).Value = Brand(i)
Next i
Range("AE:AF").Sort Key1:=Range("AF2"), Order1:=xlDescending, Header:=xlYes
I've added a line to write the brand to AE, and altered the Sort to accommodate this.

My user defined VBA function is updating all cells using it with the same thing, I don't want it too

I am trying to make it easier for users to work with an excel sheet instead of having to modify an arduous expression anytime a change is needed. I am dynamically placing the function's result into a cell. I got everything functioning how it should except:
If I go to another sheet and use the formula, it will return the proper results; however, when returning to another sheet that was already using using it, that sheet will display the most resent results and no longer its own instance of passed variables. These sheets also tie into a dashboard sheet so I need to make sure that if I calculate one sheet, it doesn't tamper with the others. I wasn't sure how to word this issue, so if there is nomenclature in place that I am not using or if this has been answered in the past, let me know and I will close this out.
'-------------------
'getScore
' This function is called from a cell and is passed an intager.
' The integer represents the section that it is being called from.
' There is also the sheet title that is passed thrugh to the range.
'-------------------
Function getScore(section As Integer, sheetTitle As String)
Application.Volatile
Dim rngSt As Integer
Dim rngEnd As Integer
rngSt = getRange(section, sheetTitle, 1) 'Gets start range for formula
rngEnd = getRange(section, sheetTitle, 2) 'Gets end range for formula
Dim Formula As String 'Broken into seperate concatinated lines for readablility
'-(COUNTBLANK(H" & rngSt & ":H" & rngEnd & ")),"
' This section uses nested if statements to acrue the score through each level.
Formula = "=IF(SUM(D" & rngSt & ":D" & rngEnd & ")= nonBlank(D" & rngSt & ":D" & rngEnd & "),"
Formula = Formula & "IF(SUM(F" & rngSt & ":F" & rngEnd & ")= nonBlank(F" & rngSt & ":F" & rngEnd & "),"
Formula = Formula & "IF(SUM(H" & rngSt & ":H" & rngEnd & ")= nonBlank(H" & rngSt & ":H" & rngEnd & "),"
Formula = Formula & "IF(SUM(J" & rngSt & ":J" & rngEnd & ")= nonBlank(J" & rngSt & ":J" & rngEnd & "),"
Formula = Formula & "IF(SUM(L" & rngSt & ":L" & rngEnd & ")= nonBlank(L" & rngSt & ":L" & rngEnd & "),5,4),3),2),1), 0)"
getScore = Eval(Formula) 'Evaluates formula and returns a score of 0-5.
End Function
Here is the getRange fucntion
Function getRange(section As Integer, sheetName As String, rangePoint As Integer)
Application.Volatile
Dim FindRow As Range
Dim ws As Worksheet
Dim wb As Workbook
Set wb = ActiveWorkbook
If section = 1 Then
If rangePoint = 1 Then
With wb.Sheets(sheetName)
Set FindRow = .Range("C9:C9")
End With
getRange = FindRow.Row
End If
If rangePoint = 2 Then
With wb.Sheets(sheetName)
Set FindRow = .Range("C:C").Find(What:="rngEnd", LookIn:=xlValues)
End With
getRange = FindRow.Row - 1
End If
End IF
End Function
Here is my Eval fuction
Function Eval(Ref As String)
Application.Volatile
Eval = Evaluate(Ref)
End Function
nonBlank fucntion
Function nonBlank(r As Range) As Long 'Counts and returns the number of non blank cells found in given range.
Application.Volatile
nonBlank = r.Cells.Count - WorksheetFunction.CountBlank(r)
End Function
In your case, the function is returning exactly what you tell it to. Your UDF has no specification of worksheet anywhere. What you see on the first sheet, after the second sheet calculates, is the returned value of the function, since it calculated on the second sheet. It's a little confusing, so let me try to break it down another way.
You enter a formula with UDF on Sheet1
UDF calculates on Sheet1, with Sheet1 ranges
You navigate to Sheet2 and recalculate UDF entered there
UDF calculates on Sheet2, with Sheet2 ranges
Concurrently on Sheet1 the UDF also calculates, with Sheet2 ranges (this is why you get the same results)
Since calculation doesn't happen when you change sheets, you still see the results calculated correctly.
Bottom line (TL;DR): Your UDF is poorly written.
To help with an answer to your question, please post your getRange function as Scott asked, as well as an example of how you are calling the UDF.
Edit: I see you posted the getRange function, but it's not complete. I think you're missing an End If statement perhaps. Also, your getScore function doesn't compile because you have an extra ">" character in there. Not sure what it's doing in there.
Formula = "=IF(SUM('" & sheetTitle & "'D" & rngSt & ":D" & rngEnd & ")= nonBlank('" & sheetTitle & "'D" & rngSt & ":D" & rngEnd & "),"
Formula = Formula & "IF(SUM('" & sheetTitle & "'F" & rngSt & ":F" & rngEnd & ")= nonBlank('" & sheetTitle & "'F" & rngSt & ":F" & rngEnd & "),"
Formula = Formula & "IF(SUM('" & sheetTitle & "'H" & rngSt & ":H" & rngEnd & ")= nonBlank('" & sheetTitle & "'H" & rngSt & ":H" & rngEnd & "),"
Formula = Formula & "IF(SUM('" & sheetTitle & "'J" & rngSt & ":J" & rngEnd & ")= nonBlank('" & sheetTitle & "'J" & rngSt & ":J" & rngEnd & "),"
Formula = Formula & "IF(SUM('" & sheetTitle & "'L" & rngSt & ":L" & rngEnd & ")= nonBlank('" & sheetTitle & "'L" & rngSt & ":L" & rngEnd & "),5,4),3),2),1), 0)"
Please note this is the quick fix. I wouldn't write a UDF this way. But we would need much more detail if we delve into that.
EDIT: If I understood what you need, this is a much shorter version and should fix the issue you're seeing...
Function Score( _
ByVal Section As Long, _
ByVal Anchor As Range _
) As Long
Dim CheckRange As Range
Application.Volatile True
Set CheckRange = Anchor.Parent.Range("C9", Anchor.Parent.Cells(Anchor.Parent.Rows.Count, "C").End(xlUp))
Score = Abs(CLng(WorksheetFunction.CountA(CheckRange.Offset(0, 1)) = CheckRange.Cells.Count) + _
CLng(WorksheetFunction.CountA(CheckRange.Offset(0, 3)) = CheckRange.Cells.Count) + _
CLng(WorksheetFunction.CountA(CheckRange.Offset(0, 5)) = CheckRange.Cells.Count) + _
CLng(WorksheetFunction.CountA(CheckRange.Offset(0, 7)) = CheckRange.Cells.Count) + _
CLng(WorksheetFunction.CountA(CheckRange.Offset(0, 9)) = CheckRange.Cells.Count))
End Function
You would then call these from any cell like this...
=Score(1,A1)
=Score(1,Sheet2!A1)
=Score(1,'Some other sheet'!A1)
I'm not even sure what the 'Section' variable is for. There isn't much explanation here.
Thanks, Zack Barresse

Loop through columns and paste an array formula

I am working on a problem to loop through a certain number of columns and paste in an array formula. For every new column, I have to change the formula to reflect that column address. However, when I try to run it now, I keep getting a 1004 (select method of range class failed) error. Here is what I have written:
Sub Testlee()
Dim i As Integer
Dim LastColumn As Long
Dim rng As Range
Dim colStr As String
LastColumn = 10
For i = 1 To LastColumn
colStr = Replace(Split(Columns(i).Address, ":")(0), "$", "")
ThisWorkbook.Sheets("Data Validation").Range(colStr & "2:" & colStr & "500").Select
Selection.FormulaArray = "=IF(LEN(Agent1!" & colStr & "2:" & colStr & "500) + LEN(Agent2!" & colStr & "2:" & colStr & "500) = 0,"""",(IF(Agent1!" & colStr & "2:" & colStr & "500=Agent2!" & colStr & "2:" & colStr & "500, ""YES"", Agent1!" & colStr & "2:" & colStr & "500&""||""&Agent2!" & colStr & "2:" & colStr & "500)))"
Next i
End Sub
Any help would be appreciated : )
Update: I was able to get it working using a combination of the two approaches. Here is the code that works:
For i = 1 To LastColumn
colStr = Replace(Split(Columns(i).Address, ":")(0), "$", "")
With ThisWorkbook.Sheets("Data Validation").Range("A2:A500")
ThisWorkbook.Sheets("Data Validation").Range(colStr & "2:" & colStr & "500").FormulaArray = "=IF(LEN(Agent1!RC:R[498]C)+LEN(Agent2!RC:R[498]C) = 0,"""",(IF(Agent1!RC:R[498]C=Agent2!RC:R[498]C, ""YES"", Agent1!RC:R[498]C&""||""&Agent2!RC:R[498]C)))"
End With
Next i
Thank to everyone for their help!
Try this instead:
Sub MM()
Const LastCol As Integer = 10 '// Column number to extend to
With Sheets("Data Validation").Range("A2:A500")
.Resize(500, LastCol).FormulaArray = "=IF(LEN(Agent1!RC:R[498]C)+LEN(Agent2!RC:R[498]C) = 0,"""",(IF(Agent1!RC:R[498]C=Agent2!RC:R[498]C, ""YES"", Agent1!RC:R[498]C&""||""&Agent2!RC:R[498]C)))"
End With
End Sub
Use R1C1 Notation to make the formula relevant to each cell without looping.
Also, you can use Resize() method to resize an existing range - again, saves looping. Info on Resize method here
Finally, as already mentioned - 99.99% of the time there is no need to .Select anything in vba - you can access an object's properties and methods directly without making it the Selection
From what I see, you're probably selecting the columns of Sheets 'Data Validation' while the active sheet is another worksheet.
You need to activate Data Validations Sheet first which means you add a line
ThisWorkbook.Sheets("Data Validation").Select
before the line
ThisWorkbook.Sheets("Data Validation").Range(colStr & "2:" & colStr & "500").Select
This is provided you don't need to run anymore code which uses the current activesheet.

average if greater than zero vba

I am trying to average a column but only if the value is greater than zero. I then want it to put the information in the next blank cell in that row.
The below code was working as a simple Average but I want it to exclude any values of zero from the above cells.
With Range("D2")
.End(xlDown)(2, 1) = _
"=AVERAGE(" & .Address & ":" & .End(xlDown).Address & ")"
End With
I Tried with the following code to have it as if the cell address is greater than zero. But it keeps giving me an error to debug?
With Range("D2")
.End(xlDown)(2, 1) = _
"=AVERAGEIF(" & .Address & ":" & .End(xlDown).Address & "," & Cell.Address & " > 0," & .Address & ":" & .End(xlDown).Address & ")"
End With
Any help would be great.
Thanks
Al
Your syntax for the formula is wrong.
You need to create a formula like
=AVERAGEIF(D2:Dxx, ">0")
So use this
With Range("D2")
.End(xlDown)(2, 1) = _
"=AVERAGEIF(" & .Address & ":" & .End(xlDown).Address & ","">0"")"
End With

Unable to get the Match Property of the WorksheetFunction class error

I have a whole bunch of data on a whole bunch of sheets and for each of them, I want to find the count of the unique values in a given column.
When I use the following command in a sheeet, it works perfectly
=SUM(IF(FREQUENCY(MATCH(REST!D2:D2225,REST!D2:D2225,0),MATCH(REST!D2:D2225,REST!D2:D2225,0))>0,1))
But when I use an equivalent command inside VBA, I am getting errors
range1 = Cell(2,j).Address & ":" & Cells(k,j).Address
= Application.WorksheetFunction.SUM( Application.WorksheetFunction.IF( Application.WorksheetFunction.FREQUENCY( Application.WorksheetFunction.MATCH(Range(range1),Range(range1),0), Application.WorksheetFunction.MATCH(Range(range1),Range(range1),0))>0,1))
I have tried other combinations, like using
Application.Match
and
Application.Frequency
I've also got "type mismatch errors.
On the other hand, the following function works perfectly
Application.Worksheetfunction.Sum(Range(range2))
The big difference between range1 and range2 is that range2 data is strictly numeric while range1 data is both numeric and string.
EDIT: TO implement BX201's solution
range_TradeID_total_FL = .Cells(2, TradeId_column).Address & ":" & Cells(Finalrow, TradeId_column).Address
doubleQ = Chr(34) & Chr(34)
fStr = "=SUMPRODUCT((range_TradeID_total_FL & " <> " & " & doubleQ & ")/COUNTIF(range_TradeID_total_FL , range_TradeID_total_FL & " & " & " & doubleQ & "))"
var_TOTAL_TradeId_count_FL = Evaluate(fStr)
MsgBox var_TOTAL_TradeId_count_FL
I don't want to store the values in a cell but store it in a variable. But when I do that, the MsgBox gives me the value "True" instead of a number.
#SiddharthRout I am not aware of evaluate. Can you please tell me how it would work in my context, especially when I use variables for range.
Try this (UNTESTED)
This is an example where row is a variable.
Sub Sample()
Dim r1 As Long, r2 As Long
Dim formulaString As String
r1 = 2
r2 = 2225
'=SUM(IF(FREQUENCY(MATCH(REST!D2:D2225,REST!D2:D2225,0),MATCH(REST!D2:D2225,REST!D2:D2225,0))>0,1))
formulaString = "=SUM(IF(FREQUENCY(MATCH(REST!D" & r1 & _
":D" & r2 & _
",REST!D" & r1 & _
":D" & r2 & _
",0),MATCH(REST!D" & r1 & _
":D" & r2 & _
",REST!D" & r1 & _
":D" & r2 & _
",0))>0,1))"
Debug.Print Application.Evaluate(formulaString)
End Sub
A much simpler formula for getting count of unique values in a column is:
=SUMPRODUCT((REST!$D$2:$D$2225<>"")/COUNTIF(REST!$D$2:$D$2225,REST!$D$2:$D$2225&""))
Normal formula so no need to CSE. This works best if there are no conditions attached to your values, like maybe a simple list of names or values.
I think evaluating this should give you the result you want. You can also assign it as a formula to a cell. Either of the following two approaches works, in that regard.
Insert formula into cell
Sub UniqueCount1()
doubleQ = Chr(34) & Chr(34)
fStr = "=SUMPRODUCT((REST!D2:D2225<>" & doubleQ & ")/COUNTIF(REST!D2:D2225,REST!D2:D2225&" & doubleQ & "))"
Range("C1").Formula = fStr
End Sub
Evaluate the formula and insert result into cell
Sub UniqueCount2()
doubleQ = Chr(34) & Chr(34)
fStr = "=SUMPRODUCT((REST!D2:D2225<>" & doubleQ & ")/COUNTIF(REST!D2:D2225,REST!D2:D2225&" & doubleQ & "))"
Range("C1").Value = Evaluate(fStr)
End Sub
A third one approach is to use a scripting dictionary. This is a bit more complicated, but it's pretty fast and can be used in a myriad of ways.
Sub UniqueDict()
Dim oDict As Object
Dim sElem As Variant, sList As Variant
sList = ThisWorkbook.Sheets("REST").Range("D2:D2225").Value
Set oDict = CreateObject("Scripting.Dictionary")
With oDict
For Each sElem in sList
If Not .Exists(sElem) And Not IsEmpty(sElem) Then
.Add sElem, Empty
End If
Next sElem
End With
MsgBox oDict.Count
End Sub
Hope this helps.
EDIT:
Here's an approach using your variables.
startRow = 2 'Or whatever it is based on your other code.
finalRow = 2225 'Or whatever it is based on your other code.
rngStr = "REST!$D$" & Startrow & ":$D$" & Finalrow '$D$2:$D$2225
dQ = Chr(34) & Chr(34) 'Double quote string.
fStr1 = "=SUMPRODUCT((" & rngStr & "<>" & dQ & ")" '=SUMPRODUCT((REST!$D$2:$D$2225<>"")
fStr2 = "/COUNTIF(" & rngStr & "," & rngStr & "&" & dQ & "))" '/COUNTIF($D$2:$D$2225,$D$2:$D$2225&""))
fStr = fStr1 & fStr2 '=SUMPRODUCT((REST!$D$2:$D$2225<>"")/COUNTIF($D$2:$D$2225,$D$2:$D$2225&""))
var_Total = Application.Evaluate(fStr)
MsgBox var_Total
Hope this helps.

Resources