How to call VBA Function from excel sheet - excel

Whenever I try to call the function from a cell by typing =MAE() it won't run, always returns a 0. Can someone help guide me? The function below works fine as a sub procedure. It needs to loop through an entire column and calculate the absolute average
Function MAE() As Double
Dim cell As Object
Dim nRows As Integer
Dim total As Double
Dim i As Integer
Dim mean As Double
total = 0
' Count the rows
With wsData.Range("A2")
nRows = Range(.Offset(0, 0), .End(xlDown)).Rows.Count
End With
'loop through rows, add to total, select next cell
Range("A2").Select
For i = 0 To nRows
total = total + Abs(ActiveCell.Value)
ActiveCell.Offset(1, 0).Select
Next i
MAE = total / (nRows)
End Function

You rarely have to select or activate cells. Never select or activate from a UDF.
Use Application.Volatile so that your function will recalculate as values change.
Function MAE() As Double
Dim cell As Object
Dim rCells As Range
Application.Volatile
With wsData.Range("A2")
Set rCells = Range(.Offset(0, 0), .End(xlDown))
For Each cell In rCells
total = total + Abs(cell.value)
Next cell
End With
MAE = total / rCells.Count
End Function
This might be more useful.
MAE(A2:A7)
Function MAE(rCells As Range) As Double
Dim cell As Object
Application.Volatile
For Each cell In rCells
total = total + Abs(cell.value)
Next cell
MAE = total / rCells.Count
End Function

I would avoid selecting the cells when looping through them.
With the following code it works for me:
...
' Count the rows
With ActiveSheet.Range("A2")
nRows = Range(.Offset(0, 0), .End(xlDown)).Rows.Count
End With
'loop through rows, add to total, select next cell
For i = 0 To nRows
total = total + Abs(ActiveSheet.Range("A2").Offset(i, 0).Value)
Next i
...

Related

Generate 1:N Sequence Array

I am currently trying to generate an array of sequential numbers (1:N) in order to populate a horizontal range ($C$6:N). When I use application.transpose my entire range is populated with 1, and when I don't use it the entire range is blank. I have attached my code below. pn is the range I want to populate and nop is the count of it. Thank you!
Best,
M
pn.Value = Array(Application.WorksheetFunction.Sequence(1, nop.Value))
I've put 2 options below,
Number one: (this seems to be what you want)
Sub generateSequence_MethodOne()
'Start at a cell and generate till a number
Dim pn As Range
Dim nop As Long
Set pn = Range("C6") 'starting cell
nop = 250 'number of entries
With pn
.value = 1
.AutoFill Destination:=pn.Resize(, nop), Type:=xlFillSeries
End With
' 'if you want to loop instead, then use this instead of the above
' For i = 1 To nop
' pn.Offset(, i - 1).value = i
' Next
End Sub
and number two, use this if you have known range that you want to fill, not knowing until what number
Sub generateSequence_MethodTwo()
'set a range and fill it with a sequence
Dim cell As Range
Dim n As Long
n = 1
For Each cell In Range("C6:Z6").Cells 'known range to fill
cell.value = n
n = n + 1
Next
End Sub
To use SEQUENCE() within VBA to fill from B9 to M9:
Sub FillUsingSequence()
Dim rng As Range
Set rng = Range("B9:M9")
rng.Value = Application.WorksheetFunction.Sequence(1, rng.Count, 1, 1)
End Sub

User Defined Function Returning #Value

I have come across a situation which required me to average the result of an array of Vlookups. I had no idea how to achieve this with formulas and it seemed like nobody else on StackOverflow had any idea either.
So I decided to write a function to do the job for me. Unfortunately it returns the "#VALUE!" error and I have no idea why! The function works fine when tested with a msgbox. I have annotated my code below:
Option Explicit
Public Function AvgVlookup(Target_Array As String, Lookup_Array As String, Column_Index As Long) As Double
Dim Result As Double
Dim Total As Double
Dim Counter As Long
Dim TargetRange As Range
Dim LookupRange As Range
Dim Cell As Range
' Remove Absolute Indicator
Target_Array = Replace(Target_Array, "$", "")
Lookup_Array = Replace(Lookup_Array, "$", "")
' Convert String to Range
Set TargetRange = Range(Left(Target_Array, InStr(1, Target_Array, ":") - 1), Mid(Target_Array, InStr(1, Target_Array, ":") + 1))
Set LookupRange = Range(Left(Lookup_Array, InStr(1, Lookup_Array, ":") - 1), Mid(Lookup_Array, InStr(1, Lookup_Array, ":") + 1))
' Set Variables to 0
Counter = 0
Total = 0
' For each cell in defined array
For Each Cell In TargetRange
' Vlookup the cell and save lookup value to Result variable
Result = Application.WorksheetFunction.vlookup(Cell, LookupRange, Column_Index, "False")
' Update variables used to calculate average
Total = Total + Result
Counter = Counter + 1
Next Cell
' Perform calculation
AvgVlookup = Total / Counter
End Function
Sub test()
MsgBox AvgVlookup("A5:A8", "G5:H8", 2)
End Sub
Any ideas?
Thanks!
Two things:
First, the way you are setting your ranges are a little long, it can be truncated to simply:
Set TargetRange = Range(Target_Array)
No need to parse the strings after removing the $.
Second, you need to put in an error check in case one of the values in the target range is not in the lookup range.
The whole code:
Public Function AvgVlookup(Target_Array As String, Lookup_Array As String, Column_Index As Long) As Double
Dim Total As Double
Dim Counter As Long
Dim TargetRange As Range
Dim LookupRange As Range
Dim Cell As Range
' Remove Absolute Indicator
Target_Array = Replace(Target_Array, "$", "")
Lookup_Array = Replace(Lookup_Array, "$", "")
' Convert String to Range
Set TargetRange = Range(Target_Array)
Set LookupRange = Range(Lookup_Array)
' Set Variables to 0
Counter = 0
Total = 0
' For each cell in defined array
For Each Cell In TargetRange
' Vlookup the cell and save lookup value to Result variable
Dim Result
Result = Application.VLookup(Cell, LookupRange, Column_Index, "False")
If IsNumeric(Result) Then
Total = Total + Result
Counter = Counter + 1
End If
Next Cell
' Perform calculation
AvgVlookup = Total / Counter
End Function
With the above function to call from the worksheet you would need to call it like this: =AvgVlookup("A5:A8", "G5:H8", 2)
But that is not very helpful. If you change your inputs to ranges:
Public Function AvgVlookup(TargetRange As Range, LookupRange As Range, Column_Index As Long) As Double
Dim Result As Double
Dim Total As Double
Dim Counter As Long
Dim Cell As Range
' Set Variables to 0
Counter = 0
Total = 0
' For each cell in defined array
For Each Cell In TargetRange
' Vlookup the cell and save lookup value to Result variable
Dim t
t = Application.VLookup(Cell, LookupRange, Column_Index, "False")
If IsNumeric(t) Then
Total = Total + t
Counter = Counter + 1
End If
Next Cell
' Perform calculation
AvgVlookup = Total / Counter
End Function
Then you would call it simply, =AvgVlookup($A$5:$A$8,$G$5:$H$8,2). This way you can just highlight the correct ranges and it will work. Also less typing trying to convert a string to a range when what you want to enter is a range.

Counting Visible Blank cells in a row

I have a data set with a large number of blank fields in each column. I would like to count the number of blank cells in each column after I've applied some arbitrary filters to other column(s).
I've gotten this to work in a sub with the following
Sub whatever()
Dim myrange As Range
Set myrange = Worksheets("Sheet1").Range("a1:a100")
myrange.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeBlanks).Count
End Sub
But when I try to put it in a UDF like so
Function CountBlankVisible(myrange As Range)
CountBlankVisible = myrange.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeBlanks).Count
End Function
It seems to be counting every cell in the range regardless of cell type. Any ideas why this would work in a sub but not as a function? is it possible to get this count some other way?
Excel UDF has some limitations (when called from worksheet). You can read about them here.
Here is working example:
Function CountBlankVisible(myrange As Range)
Dim c As Range
For Each c In myrange
If c.RowHeight > 0 And IsEmpty(c.Value) Then _
CountBlankVisible = CountBlankVisible + 1
Next
End Function
As an alternative to simoco's code:
Function CountBlankVisible(myrange As Range)
Dim c As Range
For Each c In myrange
If Not c.EntireRow.Hidden And c.Value ="" Then
CountBlankVisible = CountBlankVisible + 1
End If
Next
End Function

Excel VBA manipulate array data

I have 2 worksheets, Main and Return. I have the values in Main and the results in Return. I am trying to find a particular position in an array containing an index value (the data comes from Main sheet) e.g. 10, 20, 40, 50, 60 etc...then take the 5 values above and 5 values below this index including the index value I am searching for and do an average of it returning the average to a cell on the sheet (to the Return sheet), thus doing an average of 11 values. So far I have managed to store the range in the array using:
Public Sub myArray()
Dim myArr() As Variant
Dim R As Long
Dim C As Long
myArr = Range("C6:D1126")
For R = 1 To UBound(myArr, 1)
For C = 1 To UBound(myArr, 2)
Debug.Print myArr(R, C)
Next C
Next R
End Sub
The search/find of value within the array and averaging has left me scratching my head...
Please help...thank you. Help with the code in the array or manipulating the data from the worksheet itself works fine by me :)
Sample file --> http://www.filedropper.com/indexes
You could use this UDF:
Function avrg(indx, rng As Range)
Dim i, minI As Long, maxI As Long
i = Application.Match(indx, rng.Columns(2), 0)
If IsError(i) Then
avrg = CVErr(xlErrNA)
Exit Function
End If
With WorksheetFunction
minI = .Max(1, i - 5)
maxI = .Min(rng.Rows.Count, i + 5)
avrg = .Average(rng.Cells(1, 1).Offset(minI - 1).Resize(maxI - minI + 1))
End With
End Function
This UDF finds first entry of value (say 10 or 20) in Index column (Main sheet) takes 5 values above and 5 below it and returns average of corresponding values of column Value (Main sheet). If you need to take average of values from column Index, change rng.Cells(1, 1) to rng.Cells(1, 2)
Also note at this lines in UDF:
minI = .Max(1, i - 5)
maxI = .Min(rng.Rows.Count, i + 5)
if we can't take 5 values below and 5 values above index i (e.g. if index of target value equals to 2) we take in first case all values from start and in second case all values untill end of range.
Then you can call it either from worksheet: enter this formula in sheet Dash cell C4: =avrg(C3,Main!$C$6:$D$1126) and drag it across.
either from VBA:
Sub test()
Dim rng As Range
Dim rngInd As Range
Dim cell As Range
Set rng = ThisWorkbook.Worksheets("Main").Range("C6:D1126")
Set rngInd = ThisWorkbook.Worksheets("Dash").Range("C3:L3")
For Each cell In rngInd
cell.Offset(1).Value = avrg(cell.Value, rng)
Next cell
End Sub
In both cases function returns #N/A if indx value not found.

Using Excel VBA to get min and max based on criteria

I am trying to get the earliest start date (min) and the furthest end date (max) based on criteria in a source column. I have created several functions based on a solution I found on the internet. I have also tried an array formula solution without using VBA. Neither of the approaches have worked. I have found similar questions/answers on SO but none that correctly apply to my situation.
In my example below I have a Task worksheet and an Export worksheet. The Export worksheet is the source data. In the Task worksheet I am trying to enter a formula that finds the minimum start date. Each Task ID can have several dates so I am trying to find the lowest and highest start dates for each of the tasks. I originally tried using an array formula but ran into the same problem which is that sometimes the formula produces the correct answer and sometimes it gives an incorrect answer and I cannot locate the source of the issue. Any help is much appreciated!
VBA Functions:
Function getmaxvalue(Maximum_range As Range)
Dim i As Double
For Each cell In Maximum_range
If cell.Value > i Then
i = cell.Value
End If
Next
getmaxvalue = i
End Function
Function getminvalue(Minimum_range As Range)
Dim i As Double
i = getmaxvalue(Minimum_range)
For Each cell In Minimum_range
If cell.Value < i Then
i = cell.Value
End If
Next
getminvalue = i
End Function
Function GetMinIf(SearchRange As Range, SearchValue As String, MinRange As Range)
Dim Position As Double
Position = 1
Dim getminvalue As Double
getminvalue = MinRange.Rows(1).Value
For Each cell In SearchRange
If LCase(SearchValue) = LCase(cell.Value) And MinRange.Rows(Position).Value < getminvalue Then
getminvalue = MinRange.Rows(Position).Value
End If
Position = Position + 1
Next
GetMinIf = getminvalue
End Function
Function GetMaxIf(SearchRange As Range, SearchValue As String, MaxRange As Range)
Dim Position As Double
Position = 1
Dim getmaxvalue As Double
For Each cell In SearchRange
If LCase(SearchValue) = LCase(cell.Value) And MaxRange.Rows(Position).Value > getmaxvalue Then
getmaxvalue = MaxRange.Rows(Position).Value
End If
Position = Position + 1
Next
GetMaxIf = getmaxvalue
End Function
The issue is that you are trying to equate positions incorrectly. Use this for the MinIf, it no longer needs the secondary function:
Function GetMinIf(SearchRange As Range, SearchValue As String, MinRange As Range)
Dim srArr As Variant
srArr = Intersect(SearchRange.Parent.UsedRange, SearchRange).Value
Dim mrArray As Variant
mrarr = Intersect(MinRange.Parent.UsedRange, MinRange).Value
Dim minTemp As Double
minTemp = 9999999999#
Dim i As Long
For i = 1 To UBound(srArr, 1)
If LCase(SearchValue) = LCase(srArr(i, 1)) And mrarr(i, 1) < minTemp Then
minTemp = mrarr(i, 1)
End If
Next i
GetMinIf = minTemp
End Function
Max:
Function GetMaxIf(SearchRange As Range, SearchValue As String, MaxRange As Range)
Dim srArr As Variant
srArr = Intersect(SearchRange.Parent.UsedRange, SearchRange).Value
Dim mrArray As Variant
mrarr = Intersect(MaxRange.Parent.UsedRange, MaxRange).Value
Dim maxTemp As Double
maxTemp = 0
Dim i As Long
For i = 1 To UBound(srArr, 1)
If LCase(SearchValue) = LCase(srArr(i, 1)) And mrarr(i, 1) > maxTemp Then
maxTemp = mrarr(i, 1)
End If
Next i
GetMaxIf = maxTemp
End Function
As far as formula go IF you have OFFICE 365 then use MINIFS
=MINIFS(Export!F:F,Export!A:A,A2)
=MAXIFS(Export!G:G,Export!A:A,A2)
If not use AGGREGATE:
=AGGREGATE(15,7,Export!$F$2:F$26/(Export!$A$2:A$26=A2),1)
=AGGREGATE(14,7,Export!$G$2:G$26/(Export!$A$2:A$26=A2),1)
I was trying to use Scott's method as part of a macro to transform an invoice. However, the rows of the invoice fluctuate every month and could grow to as many as a million in the future. Anyway, the bottomline is that I had to write the formula in a way where I could make the last row dynamic, which made the macro go from taking 10-15 minutes (by hardcoding a static last row like 1048576 to run to ~ 1 minute to run. I reference this thread to get the idea for the MINIFS workaround and another thread to figure out how to do a dynamic last row. Make vba excel function dynamic with the reference cells
I'm sure there are other methods, perhaps using offset, etc. but I tried other methods and this one was pretty quick. Anyone can use this VBA formula if they do the following:
15 to 14 to do a maxifs, keep as is for minifs
change the relevant rows and columns in Cells(rows, columns) format below.
The True/False parameters passed to .Address() will lock/unlock the rows/columns respectively (i.e. add a $ in front if True).
Change the last row
First, get the last row
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Second, here is the dynamic minifs
Range("F2").Formula = "=AGGREGATE(15,7," & Range(Cells(2, 6), Cells(LastRow, 6)).Address(True, True) & "/(" & Range(Cells(2, 1), Cells(LastRow, 1)).Address(True, True) & "=" & Range(Cells(2, 1), Cells(2, 1)).Address(False, True) & "),1)"
Third, autofill down.
Range("F2").AutoFill Destination:=Range("F2:F" & LastRow)

Resources