Custom Function Entering the Result Array into a Different Cell - vba

I have created my own function to determine count the values in between to given values in increments of 30 as seen here
Function InBetween(First As Integer, Last As Integer)
Dim i As Long, F As String, a() As String
F = First
For i = First + 30 To Last Step 30
F = F & "|" & i
Next i
InBetween = F
End Function
When I use this function, I currently have it returning the result array in the cell the formula was entered into in the format of "1|2|3|4". Is there a way I can get this array to populate into the cell below the one containing the formula?
Note: I don't want the formula in the cell as I need to refer to the cell in a future equation that will use the result and not the equation.

This was surprisingly difficult. At first I tried calling a sub from the function to affect the cell below using application.caller but this always returned a #value error. It seems a UDF can't run anything that affects the worksheet.
Eventually I came up with this:
Create a worksheet change event by pasting this into the worksheet object in vb:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Left(Target.Offset(-1, 0).Formula, 10) = "=InBetween" Then Call DoX(Target.Offset(-1, 0), InBetween(10, 60))
On Error GoTo 0
End Sub
Then paste this into a module
Sub DoX(r As Range, val As String)
Sheets(r.Parent.Name).Cells(r.Row, r.Column) = ""
Sheets(r.Parent.Name).Cells(r.Row + 1, r.Column) = val
End Sub
Then use your function as normal, but remember to hit return after you enter it so the active cell is the cell below where you entered the formula.

Related

Call a specific macro for one cell, based on the value of another cell

I have a macro GETGUID(). Would want to call the macro on Column 'B' whenever the corresponding column 'A' has a value in it. If Column A is empty, then GETGUID macro should not be called for the corresponding column B.
I tried the following code, but it is not working. For a test, I am using range A1:A20 but it can be any range. GETGUID() macro works fine if I type manually in column B but I want this to work whenever corresponding cell in column A has some value.
My knowledge in using Macros is not so good. Here is the code I am trying:
Public Function GetGUID() As String
GetGUID = Mid$(CreateObject("Scriptlet.TypeLib").GUID, 2, 36)
End Function
Dim cell_to_test As Range, cells_changed As Range
Set cells_changed = Target("A1:A20")
Set cell_to_test = Range("B1:B20")
If Not Intersect(cells_changed, cell_to_test) Is Nothing Then
Range("B1:B12") = GetGUID()
End If
I've created a simple Macro which loops through each cell declared by Worksheets(1).Range("A1:A20"). If a value is present (not vbNullString) then the column to the right is populated with a GUID.
Private RANGE_CELL As Range
Public Function GetGUID() As String
GetGUID = Mid$(CreateObject("Scriptlet.TypeLib").GUID, 2, 36)
End Function
Public Sub Populate_B()
For Each RANGE_CELL In Worksheets(1).Range("A1:A20")
If RANGE_CELL <> vbNullString Then
RANGE_CELL.Offset(, 1).Value = GetGUID
Else
'// Do nothing.
End If
Next RANGE_CELL
End Sub
Let me know if you need anything, happy to help.

Simple moving average range in Excel-VBA

This code is just to calculate simple moving average. Opened an excel, created dummy array in C row from 1 to 20. I want to create a function for eg: SMA(C7,3) = which should give average of C5:C7.
Coming back to VBA after long time, not able to figure whats the error in the below code.
Function sma1(rng As Range, N As Integer)
Set rng = rng.Resize(-N + 1, 0)
sma1 = Application.WorksheetFunction.average(rng)
End Function
avoid using a cell name as a function
fixed the RESIZE()
used an internal range variable
Function smal(rng As Range, N As Integer) As Variant
Dim rng2 As Range
Set rng2 = rng.Resize(N, 1)
smal = Application.WorksheetFunction.Average(rng2)
End Function
EDIT#1:
Based on Scott's comment:
Function smal(rng As Range, N As Integer) As Variant
Dim rng2 As Range
Set rng2 = rng.Offset(1 - N, 0).Resize(N, 1)
smal = Application.WorksheetFunction.Average(rng2)
End Function
I assume you want the column along side it to give you're SMA (as shown below?):
If so, the below will do it and drag it autocomplete it to the bottom of you column C array:
Sub SMA3()
Range("D7").FormulaR1C1 = "=AVERAGE(R[-2]C[-1]:RC[-1])" 'This is a relative reference (left one cell and up two cells) - This give your three inputs
Range("D7").AutoFill Destination:=Range("D7:D" & Range("C1048576").End(xlUp).Row) 'Autofills the SMA
End Sub
Just an FYI this can be done with existing formula:
=IF(ROW(C1)<$E$1,"",AVERAGE(INDEX(C:C,ROW(C1)-$E$1+1):C1))
E1 contains the number of rows to include.

UDF returns the same value everywhere

I am trying to code in moving average in vba but the following returns the same value everywhere.
Function trial1(a As Integer) As Variant
Application.Volatile
Dim rng As Range
Set rng = Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row - a + 1, 2))
trial1 = (Application.Sum(rng)) * (1 / a)
End Function
The ActiveCell property does not belong in a UDF because it changes. Sometimes, it is not even on the same worksheet.
If you need to refer to the cell in which the custom UDF function resides on the worksheet, use the Application.Caller method. The Range.Parent property can be used to explicitly identify the worksheet (and avoid further confusion) in a With ... End With statement.
Function trial1(a As Integer) As Variant
Application.Volatile
Dim rng As Range
with Application.Caller.Parent
Set rng = .Range(.Cells(Application.Caller.Row, 2), _
.Cells(Application.Caller.Row - a + 1, 2))
trial1 = (Application.Sum(rng)) * (1 / a)
end with
End Function
You've applied the Application.Volatile¹ method but allowed the range to be averaged to default to the ActiveSheet property by not explcitly specifying the parent worksheet.
The average is computed with the Excel Application object returning a SUM function's result and some maths. The same could have been returned in one command with the worksheet's AVERAGE function but blank cells would be handled differently.
trial1 = Application.Average(rng)
¹ Volatile functions recalculate whenever anything in the entire workbook changes, not just when something that affects their outcome changes.
It's kind of strange to me for a UDF to calculate moving average given a number. If this UDF is to be used within the Worksheet, I believe you would put it next to existing data and if you want to change the size of the range for average amount, you update them manually?
Assuming you can name a Range "MovingAverageSize" to store the size of the range to calculate the average, and the average amount on the right of the existing data, consider below:
Range C2 is named MovingAverageSize
Data stored from B3 and downwards
Moving Average result is stored 1 column on the right of the data
If the data is less than MovingAverageSize, the SUM function adjusts accordingly
Any calculation error occurs with result in zero
Every time MovingAverageSize changes value, it triggers a Sub to update the formulas (Codes are placed in the Worksheet object rather than normal Module)
Alternatively, you can change the code to place the MovingAverage to same column of the MovingAverageSize, so you can have a few different size comparing next to each other.
Code in Worksheet Object:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
If Target.Address = ThisWorkbook.Names("MovingAverageSize").RefersToRange.Address Then UpdateMovingAverage Target
End If
End Sub
Private Sub UpdateMovingAverage(ByRef Target As Range)
Dim oRngData As Range, oRng As Range, lSize As Long, lStartRow As Long
Debug.Print "UpdateMovingAverage(" & Target.Address & ")"
If IsNumeric(Target) Then
lSize = CLng(Target.Value)
If lSize <= 0 Then
MsgBox "Moving Average Window Size cannot be zero or less!", vbExclamation + vbOKOnly
Else
' Top Data range is "B3"
Set oRngData = Target.Parent.Cells(3, "B") ' <-- Change to match your top data cell
lStartRow = oRngData.Row
' Set the Range to last row on the same column
Set oRngData = Range(oRngData, Cells(Rows.Count, oRngData.Column).End(xlUp))
Application.EnableEvents = False
For Each oRng In oRngData
If (oRng.Row - lSize) < lStartRow Then
oRng.Offset(0, 1).FormulaR1C1 = "=iferror(sum(R[" & lStartRow - oRng.Row & "]C[-1]:RC[-1])/MovingAverageSize,0)"
Else
oRng.Offset(0, 1).FormulaR1C1 = "=iferror(sum(R[" & 1 - lSize & "]C[-1]:RC[-1])/MovingAverageSize,0)"
End If
Next
Application.EnableEvents = True
Set oRngData = Nothing
End If
End If
End Sub
Sample data and screenshots
I believe that Application.ActiveCell is not what you should be using here.
Application.ThisCell would be more appropriate assuming that "a" is the size of the subset and that the dataset is 1 column on the right.
Moreover, I would simply use "WorksheetFunction.Average" instead of "Application.Sum" and I would add "Application.Volatile" so the average is recalculated whenever an update occurs on the worksheet.
So one solution to your issue would be:
Public Function Trial1(a As Integer) As Variant
Application.Volatile
Trial1 = WorksheetFunction.Average(Application.ThisCell(1, 2).Resize(a))
End Function
Another solution here would be to use an array formula entered with Control/Shift/Enter:
Public Function MovAvg(dataset As Range, subsetSize As Integer)
Dim result(), subset As Range, i As Long
ReDim result(1 To dataset.Rows.count, 1 To 1)
Set subset = dataset.Resize(subsetSize)
For i = 1 To dataset.Rows.count
result(i, 1) = WorksheetFunction.Average(subset.offset(i - 1))
Next
MovAvg = result
End Function
And to use this array function:
Select the range where all the results will be written (should be the size of your dataset)
Type "=MovAvg(A1:A100, 2)" where A1:A100 is the source of the data and 2 the size of the subset
Press Ctrl+Shift+Enter
A UDF should only access a range when it is passed as a parameter.
Also, you should eliminate Application.Volatile because (1) your calculation is deterministic and not volatile, (2) Excel will re-calculate automatically your UDF whenever any cell in the input range changes, and (3) because the 'volatile' attribute in a UDF can make a model very slow so it should avoided when not necessary.
So, for a moving average, the correct formula is:
Public Function SpecialMovingAverage(Rng as Excel.Range) As Double
Dim denominator as Integer
denominator = Rng.Cells.Count
if Denominator = 0 then SpecialMovingAverage = 0: exit function
' write your special moving average logic below
SpecialMovingAverage = WorksheetFunction.Average(Rng)
End Function
Note: I changed the answer following two comments because I initially did not see that the question was after a moving average (maybe the question was changed after my answer, or I initially missed the UDF's stated objective).
I believe
Your trial1() function is in one or more cells, as a part of a formula or by itself
You want those cells to be recalculated whenever the user changes any cell on the worksheet
For this, you'd need to identify the cell where the change happened. This cell is not given by
A. ActiveCell - because that is the cell the cursor is on when the calculation starts; it could be anywhere but not on the cell that was changed
B. Application.ThisCell - because that returns the cell in which the user-defined function is being called from, not the cell that changed
The cell where the change happened is passed to the Worksheet's Change event. That event is triggered with an argument of type Range - the range that changed. You can use that argument to identify the cell(s) that changed and pass that to trial1(), possibly through a global variable (yeah, I know).
I tried this in a worksheet and it works, so let me know your results.

Convert VBA Macro to Function

I have been trying to create a function to retrieve column titles found in row four in an excel sheet. This is what I have so far, can anybody help me please?
Sub Test_Click()
Dim text As String
Dim titles(200) As String
Dim nTitles As Integer
For i = 1 To 199
If Trim(Sheets("Sheet1").Cells(4, i).Value) = "" Then
nTitles = i - 1
Exit For
End If
titles(i - 1) = Sheets("Sheet1").Cells(4, i).Value
Next
For i = 0 To nTitles
Sheets("Sheet1").Cells(20 + i, 1).Value = titles(i)
Next
End Sub
You need to make an array function for this. So your function will take in inputs through a range
Function ReturnArray(Input as Range) as Variant
' Do stuff with the Input range
Dim Output(m,n) as Variant
'Loop through m,n to fill in the output values as you would in a range
ReturnArray = Output
End Function
And when you put in the function in excel, type it in the cell after highlighting where you want the output and press Ctrl-Shift-Return
Just as you write a Sub you can write a Function, just substitute the words at the beginning and at the end of your code.
Now, about how to return the values, obviously it will be an array, so you'll need to declare the array, set its size, fill its cells and return it. This can be done like this:
Function yourFunction() as String()
' You already have an array named "titles" which stores the values you want
' to return. Fill it exactly as you do in your original code.
yourFunction = titles ' This is the way to return the array.
End Function
If you want to use this function in a worksheet (as a formula), remember that this is an array-function, so you'll need to press Ctrl+Shitf+Enter after you enter the function in the cell instead of just [Enter].

How do I get the cell value from a formula in Excel using VBA?

I have a formula in a range of cells in a worksheet which evaluate to numerical values. How do I get the numerical values in VBA from a range passed into a function?
Let's say the first 10 rows of column A in a worksheet contain rand() and I am passing that as an argument to my function...
public Function X(data as Range) as double
for c in data.Cells
c.Value 'This is always Empty
c.Value2 'This is always Empty
c.Formula 'This contains RAND()
next
end Function
I call the function from a cell...
=X(a1:a10)
How do I get at the cell value, e.g. 0.62933645?
Excel 2003, VB6
The following code works for me when running from VBA (Excel 2003):
Public Function X(data As Range) As Double
For Each c In data.Cells
a = c.Value 'This works
b = c.Value2 'This works too (same value)
f = c.Formula 'This contains =RAND()
Next
End Function
a and b are the same and equal what I'm passing in (which is a range of cells with Rand() in them). I'm not sure what else is going on here.
Aha! You need to set X, no? I'm not sure what exactly you expect this function to do, but you need to set X (the name of the function) to the value you want returned. Add this line:
X = a
I can't replicate a problem using the layout you posted. I noticed a few syntax errors in your posted code (ie: "for" should be "for each"). But when I put =RAND() in A1:A10 and =X(A1:A10) I got a return just fine with this:
Public Function X(data As Range) As Double
Dim c As Excel.Range
Dim sum As Double
For Each c In data.Cells
sum = sum + c.Value
Next
X = sum
End Function
However, just to a expand a little more on a few of the other questions you brushed up against. You can evaluate a formula for a result like so:
Public Function X(data As Range) As Double
Dim c As Excel.Range
Dim sum As Double
For Each c In data.Cells
sum = sum + Excel.Evaluate(c.Formula)
Next
X = sum
End Function
But generally speaking you won't want to, as this is basically calculating the same value twice.
Make sure you do a calculate before requesting the value.
To Speed up macros something like the following is often preformed..
'Set Reasonable default
Application.CutCopyMode = False
Application.ScreenUpdating = False
Application.Interactive = False
Application.Calculation = xlCalculationManual
in this state you must force calculation before the value will be available.
Public Function X(data As Range) As Double
'You may need the following as well
'Application.Calculate
Dim c As Range
For Each c In data.Cells
c.Calculate
c.Value 'This is now has a value
c.Value2 'This is now has a value
c.Formula 'This contains RAND()
Next
End Function