I've got 2 very similar functions, that were working before I switched my code to the Option Explicit for debugging puposes (success !). Since then, the Max function does not work anymore and I can't elaborate the reason why and solve it as an xl vba perfect noob.
The Max function (does not work):
Function MaxAddress(The_Range) As Variant
' See http://support.microsoft.com/kb/139574
Dim MaxNum As Variant
Dim cell As Range
' Sets variable equal to maximum value in the input range.
MaxNum = Application.Max(The_Range)
' Loop to check each cell in the input range to see if equals the
' MaxNum variable.
For Each cell In The_Range
If cell.Value = MaxNum Then
' If the cell value equals the MaxNum variable it
' returns the address to the function and exits the loop.
MaxAddress = cell.Address
Exit For
End If
Next cell
End Function
The runtime error :
I receive "error 91" at the runtime, with the Xmax valuing : "Nothing"
Error 91 stands for : undefined object or With block variable
The min function (works)
Function MinAddress(The_Range) As Variant
' See http://support.microsoft.com/kb/139574
Dim MinNum As Variant
Dim cell As Range
' Sets variable equal to maximum value in the input range.
MinNum = Application.Min(The_Range)
' Loop to check each cell in the input range to see if equals the
' MaxNum variable.
For Each cell In The_Range
If cell.Value = MinNum Then
' If the cell value equals the MaxNum variable it
' returns the address to the function and exits the loop.
MinAddress = cell.Address
Exit For
End If
Next cell
End Function
How I call both functions :
Set rng = ws_source.Range("3:3")
X_min = MinAddress(rng)
X_max = MaxAddress(rng) ' returns : X_max = Nothing
The data are in the row 3, containing formatted numbers and text.
(not an answer but too big for a comment)
I have the following in a normal module and it works fine:
Function MaxAddress(The_Range) As Variant
' See http://support.microsoft.com/kb/139574
Dim MaxNum As Variant
Dim cell As Range
' Sets variable equal to maximum value in the input range.
MaxNum = Application.Max(The_Range)
' Loop to check each cell in the input range to see if equals the
' MaxNum variable.
For Each cell In The_Range
If cell.Value = MaxNum Then
' If the cell value equals the MaxNum variable it
' returns the address to the function and exits the loop.
MaxAddress = cell.Address
Exit For
End If
Next cell
End Function
Sub xxx()
Dim rng As Range
Dim X_max As String
Set rng = ThisWorkbook.Sheets(1).Range("3:3")
X_max = MaxAddress(rng)
MsgBox (X_max)
End Sub
Not sure why min works, but I believe it's supposed to be
Application.WorksheetFunction.Max
&
Application.WorksheetFunction.Min
Related
I'm trying to write a macro that would identify the last timestamp within a column, add a defined number of days and update a due date for every column in my data set, until it reaches a blank column.
This is a screenshot of the data set where I want the calc to run:
For other calculations, I'm using the ActiveCell.Offset to navigate my spreadsheet and run the calculations, but using it for this case is getting very confusing.
Sample of code for existing calculations:
ws.Range("B74").Select
Do Until ActiveCell.Offset(0, 1).Value = ""
ActiveCell.Offset(-23, 1).Formula = "=Round(((R[-2]C[0]+R[-4]C[0])/R[-14]C[0])*100,2)"
If IsError(ActiveCell.Offset(-23, 1)) Then ActiveCell.Offset(-23, 1).Value = "0"
ActiveCell.Offset(0, 1).Select
Loop
In your case I would define an user-defined function (place the macro in a standard module) and then use that function inside the sheet as formula. The function returns the value of the last non empty cell and you then can perform your calculation directly in the sheet. Value2 is used to get the underlying value of the cell without taking formats into account.
Looks like you're interested in the navigation part (title of question). I show you three ways to get the last (I hope I understood your definition of last correctly) non empty cell in a range with a width of 1 column:
Looping through range (getLastValueWithLoop)
Using .End(xlUp) (getLastValueWithEnd)
Writing range values to array and then loop the array (fastest) (getLastValueWithArrayLoop)
I also included a function (updateDueDateInEachColumn) that goes through each column and updates the due date programmatically to not have to use the user-defined function.
Btw: You could prolly ditch using macros and just use a normal formula (see screenshot).
Code:
' **
' Get the value of the last non empty cell in rng
' #param {Range} rng Range to look in, 1 column only
' #return {Variant} Returns the value of the last non empty cell
' or false if all cells are empty
' Example:
' Use following function inside a sheet:
' =getLastValueWithLoop(A2:A6)
Public Function getLastValueWithLoop(rng As Range) As Variant
Dim i As Long
' Loop through range and check if cell is not empty
' Starts at the bottom and moves 1 cell up each time
For i = rng.Cells.Count To 1 Step -1
If rng(i).Value2 <> "" Then
getLastValueWithLoop = rng(i).Value
Exit Function
End If
Next
' if no value in range set to false
getLastValueWithLoop = False
End Function
' **
' Get the value of the last non empty cell in rng
' #param {Range} rng Range to look in, 1 column only
' #return {Variant} Returns the value of the last non empty cell
' or false if all cells are empty
' Example:
' Use following function inside a sheet:
' =getLastValueWithEnd(A2:A6)
Public Function getLastValueWithEnd(rng As Range) As Variant
Dim i As Long
Dim lastCell As Range
Dim lastNonEmptyCell As Range
' Set last cell in range
Set lastCell = rng(rng.Cells.Count)
' Use .end(xlup) to get first non empty
' This is the same as using the keys CTRL + Up
If lastCell <> "" Then
' Needs to check if last cell is empty first as else
' end(xlup) would move up even if the cell is non empty
' Set as last non empty cell if not empty
getLastValueWithEnd = lastCell.Value2
Exit Function
Else
' Use end(xlup) to get the first non empty cell moving up from
' the last cell. Check if the cell found with end(xlup) is inside the range
' with .Intersect as end(xlup) can move outside the range provided
' If it is inside the range set last non empty cell
If Not Application.Intersect(rng, lastCell.End(xlUp)) Is Nothing Then
getLastValueWithEnd = lastCell.End(xlUp).Value2
Exit Function
End If
End If
' if no value in range set to false
getLastValueWithEnd = False
End Function
' **
' Get the value of the last non empty cell in rng
' #param {Range} rng Range to look in, 1 column only
' #return {Variant} Returns the value of the last non empty cell
' or false if all cells are empty
' Example:
' Use following function inside a sheet:
' =getLastValueWithArrayLoop(A2:A6)
Public Function getLastValueWithArrayLoop(rng As Range) As Variant
Dim rngAsArray As Variant
Dim i As Long
' Write the rng values into an array
' This produces a two dimensional array
rngAsArray = rng.Value2
' Loop through the array, move from bottom up and
' return first non empty cell
For i = UBound(rngAsArray, 1) To LBound(rngAsArray, 1) Step -1
If rngAsArray(i, 1) <> "" Then
getLastValueWithArrayLoop = rngAsArray(i, 1)
Exit Function
End If
Next
' if no value in range set to false
getLastValueWithArrayLoop = False
End Function
' **
' Check rngColumn for last value (exit if none found) and
' update rngDueDate then move one column to the right etc.
' This macro relies on the function getLastValueWithLoop.
' #param {Range} rngColumn First column range to get last value in
' #param {Range} rngDueDate First cell to update due date in
' Example call in macro:
' updateDueDateInEachColumn Range("B2:B6"), Range("B7")
Public Sub updateDueDateInEachColumn(rngColumn As Range, rngDueDate As Range)
Dim rng As Range
Dim lastValue As Variant
' Loop until column is empty
Do
' Get last value of column range, returns false if no value found
lastValue = getLastValueWithLoop(rngColumn)
If lastValue = False Then
' Exit the loop if no value was found
Exit Do
Else
' Update due date
rngDueDate = lastValue + 10 ' TODO: add your calculation here
End If
' Offset column and due date range by one column
Set rngColumn = rngColumn.Offset(, 1)
Set rngDueDate = rngDueDate.Offset(, 1)
Loop
End Sub
Example usage of the functions inside a sheet:
Is it possible to offset to the right of a cell based on column headers? I have some code that loops through a range, and if it finds a specific value it will offset 12 columns to the right. Instead of saying Offset(,12), is there a way I can say offset to the right in that same row to the column with the header I want?
For example if column B is named "host" and my range is
rng = ws.range("B1:B20")
and column N is named "country", I don't want to write:
offset(,12).value = ...
Instead if there is something like:
offset(to column: country).value =...
The reason I ask for this is to not specific an offset number to make the code more resilient to any changes that may happen to my excel worksheet.
I hope the explanation is clear. thanks!
Try the Function below, will return the number of columns you need to Offset from your Rng to the "Header" you are looking for.
Option Explicit
Function OffesttoHeader(CurrentCol As Long, FindRng As Range, HeaderStr As String) As Long
Dim HeaderRng As Range
Set HeaderRng = FindRng.Find(what:=HeaderStr)
If Not HeaderRng Is Nothing Then
OffesttoHeader = HeaderRng.Column - CurrentCol + 1
Else
OffesttoHeader = -10000 ' raise to a large value >> as an error
End If
End Function
Test Sub Code (to test the function above):
Sub Test()
Dim ws As Worksheet
Dim Rng As Range
Dim NumberofCols As Long
Set ws = ThisWorkbook.Sheets("Sheet1") ' modify to your sheet's name
Set Rng = ws.Range("B1:B20")
' pass the following parameters:
' 1. Rng.column - in your case column B = 2
' 2. ws.Rows(1) - the Range to search for the Header, first row in ws worksheet
' 3. "Header" - the Header string you are searching for
NumberofCols = OffesttoHeader(Rng.Column, ws.Rows(1), "Header")
' raise an error message box
If NumberofCols = -10000 Then
MsgBox "Unable to find Header"
End If
End Sub
In order to obtain the solution you seek above, use the Range.Find Method.
'Column Number
Dim clmCountry as Integer
From here, we want to find the header by using the Range.Find Method
'to find the header
With ThisWorkbook.Sheets("SheetName")
'update the range if necessary
clmCountry = .Range("A1:Z1").Find("HeaderName").Column
End With
Once you've found the desired column, you may offset the following way:
... Offset(RowNum, clmCountry).Value = ...
I needed to get a column value out of a row defined as a Range.
Public Function ProcessOneLine(row As Range) As String
This works for me
row.Offset(0,2).Value2 ' returns the value in Column 3
row.Offset(1,Range("C1").Column).Value2 ' also returns the value in Column
So use something like this:
Dim srcColumn as String
Dim colPosn as Integer
srcColumn = "C"
colPosn = Range(srcColumn & "1").Column
cellValue = row.Offset(0,colPosn-1).Value2
How can I return a range from an function which includes an offset from another range?
This is my code (Function):
Private Function ProcessRange(rng) As Range
If rng <> "A1" Then
ProcessRange = Range(rng).Offset(r + 2) //this is the problem
Else
ProcessRange = Range("A1")
End If
End Function
From the example above, I'm trying to replace the range from the offset function. Is it possible?
There are several issues here:
You should define the type of the parameters
Use Set to set the return range
You havn't defined what r is
Offset needs two parameters, rows and columns
Because you havn't specified a Worksheet, your function will return a Range on the Active Sheet
.
Private Function ProcessRange(rng As String) As Range
If rng <> "A1" Then
Set ProcessRange = Range(rng).Offset(2, 0) ' To Offset by 2 rows
Else
Set ProcessRange = Range("A1")
End If
End Function
I want to create a function that calculate cell in a determined range.
When I return the value of the calc to excel I get an #VALUE! error, which means
that the variable types are different.
I tried to use Cint(var) and get the same error.
Here is the code without Cint():
Function CalcTest(Interval As Range) As Integer
Dim x As Integer
Dim y As Integer
x = Interval.Offset(0, 0).Value
y = Interval.Offset(1, 0).Value
CalcTest = x + y
End Function
I already tried:
Function CalcTest(Intervalo As Range) As Integer
CalcTest = Interval.Offset(0, 0).Value + Interval.Offset(1, 0).Value
End Function
And:
Function CalcTest(Interval As Range) As Integer
Dim x As Integer
Dim y As Integer
x = CInt(Interval.Offset(0, 0).Value)
y = CInt(Interval.Offset(1, 0).Value)
CalcTest = x + y
End Function
And Without declarating de function type:
Function CalcTest(Interval As Range)
...
...
End Function
And in Excel I call the function with some range:
=CalcText(A1:A2)
What Am I doing wrong?
#
The big picture:
What I need to do is create a cel in any place that counts de total values
of the $R col for every occurrency of a key value in $N col.
For every time I have "TH" in $N Col, I need do accumulate de $R col value of that
row in a cel.
Same for many others $N Values.
In this sample the value of the accumulated cel for TH in $N is 25.
Tks for the help!!!
You are making this way hard on yourself.
Put this into a cell in row 2 and drag it down:
=SUMIF(N$2:N2,"TH",R$2:R2)
Is this what you are trying?
Public Function CalcTest(rng1 As Range, rng2 As Range) As Variant
On Error GoTo Whoa
CalcTest = rng1.Value + rng2.Value
Exit Function
Whoa:
CalcTest = "Please check the Range Values"
End Function
In an Excel cell, put this formula =CalcText(A1,A2)
You should not simplify your code to something that doesn't fairly represent your question. From your comments and Question.
Function CalcTest(Interval As Range) As Integer
Dim x As Range
CalcTest = 0
For Each x In Interval
If IsNumeric(x) Then
CalcTest = CalcTest + x.Value
End If
Next x
End Function
This will make sure what you are adding up is actually a number.
But as is this will not work any different then the worksheet function:
=Sum(Range)
Simply converting the values to Integer won't work if what you are converting is not converatble. If you pass a Letter to the CInt() function it will just fail.
I have a function that takes a range of values as input (just a column) as well as some threshold. I would like to return a range that is filtered to include all values from the original range that are greater than the threshold. I have the following code:
Public Function FilterGreaterThan(Rng As Range, Limit As Double) As Range
Dim Cell As Range
Dim ResultRange As Range
For Each Cell In Rng
If Abs(Cell.Value) >= Limit Then
If ResultRange Is Nothing Then
Set ResultRange = Cell
Else
Set ResultRange = Union(ResultRange, Cell)
End If
End If
Next
Set FilterGreaterThan = ResultRange
End Function
The issue is that once a number is below the threshold, other numbers after that one that are above the threshold do not get added to the range.
For example:
Threshold - 2
Numbers -
3
4
1
5
It will loop through adding 3 and 4 but 5 will not be added. I end up getting a #value error. But I get no error and it works fine if I only enter the range - 3, 4 or the range - 3, 4, 1.
It's looks like the UDF doesn't like non-contiguous ranges being written back to an array.
One way around it is to re-write the UDF like below. It assumes the output array is only in column but does allow multiple column input.
Option Explicit
Public Function FilterGreaterThan(Rng As Range, Limit As Double) As Variant
Dim Cell As Range
Dim WriteArray() As Variant
Dim i As Long
Dim cellVal As Variant
Dim CountLimit As Long
CountLimit = WorksheetFunction.CountIf(Rng, ">=" & Limit)
ReDim WriteArray(1 To CountLimit, 1 To 1) 'change if more than 1 column
For Each Cell In Rng
cellVal = Cell.Value
If Abs(cellVal) >= Limit Then
i = i + 1 'change if more than 1 column
WriteArray(i, 1) = cellVal 'change if more than 1 column
End If
Next
FilterGreaterThan = WriteArray
End Function
ooo got there first but I've typed it out now so I may as well post it. This version will return as a column vector of the correct size.
If nothing matches then #N/A is returned in a 1 by 1 array (this is consistent with the normal behaviour of an array function when there are insufficient values to fill the array)
edit2: updated function thanks to comments from ooo
Public Function FilterGreaterThan(Rng As Range, Limit As Double) As Variant()
Dim inputCell As Range ' each cell we read from
Dim resultCount As Integer ' number of matching cells found
Dim resultValue() As Variant ' array of cell values
resultCount = 0
ReDim resultValue(1 To 1, 1 To Rng.Cells.Count)
For Each inputCell In Rng
If Abs(inputCell.Value) >= Limit Then
resultCount = resultCount + 1
resultValue(1, resultCount) = inputCell.Value
End If
Next inputCell
' Output array must be two-dimensional and we can only
' ReDim Preserve the last dimension
If (resultCount > 0) Then
ReDim Preserve resultValue(1 To 1, 1 To resultCount)
Else
resultValue(1, 1) = CVErr(xlErrNA)
ReDim Preserve resultValue(1 To 1, 1 To 1)
End If
' Transpose the results to produce a column rather than a row
resultValue = Application.WorksheetFunction.Transpose(resultValue)
FilterGreaterThan = resultValue
End Function
edit: works OK for me with the test values in the comment below:
I'm sure you know this but don't include the { or } characters when entering the array formula - Excel adds them in after you've hit Ctrl-Shift-Enter