I am trying to make a simple sum function that sums until I hit a blank cell. I am not sure why it is not working. I am trying to sum currency and have the output be a currency as well. So far I have:
Function SumContin(X)
Dim Ro As Long
Dim Col As Long
Dim Ro1 As Long
Dim Col1 As Long
Ro = Application.WorksheetFunction.Row(X)
Col = Application.WorksheetFunction.Column(X)
Do While Cells(Ro, Col) <> ""
Sum = Sum + CInt(Cells(Ro, Col))
Ro = Ro - 1
Loop
End Function
UPD:
Follow up from comments:
Can I make the function where it will be =SumContin() and it starts from the cell above?
Function SumContin()
Application.Volatile
SumContin = 0
On Error Resume Next
With Application.ThisCell
If .Row = 1 Then Exit Function
If .Offset(-1) = "" Then Exit Function
SumContin = Application.Sum(Range(.Offset(-1), .End(xlUp)))
End With
End Function
Note: since code using Application.ThisCell, function will work only in case when you call it from worksheet: =SumContin() and won't work if you call it from any code
A UDF for this seems overkill given that in the A provided the requisite range has to be keyed in anyway. A running total something like =SUM(A$1:A1) and double-clicking on the fill handle may be more convenient at times.
It would be most efficient to just define the range withing the UDF based on the cell passed, and then use the WorksheetFunction.Sum command.
Here's one way:
Function SumContin(X As Range)
SumContin = WorksheetFunction.Sum(Range(X.Address & ":" & X.End(xlDown).Address))
End Function
Related
Summary: all the occurrences of a UDF recalculate when one of them has a source changed.
I have a fairly simple UDF (code below) that calculates the stableford score of a golf round based on a couple of variables. Now I find that the UDF seems to be semi-volatile, in that as soon as I enter data in the data entry range (HoleScores) ALL of my occurrences of the UDF recalculate, even on other sheets. But if I press F9 (or choose to recalculate) they do not recalculate.
The desired situation is that only the UDF for which the data is entered recalculates. Can anybody help me achieve that?
nb: the HoleScores range is only referenced by one single UDF. All occurrences of the UDF use unique entry ranges. I have tested the recalc with the VBA screen open and closed. I am using Excel 2016
Public Function WACRondeScore(PlayingHandicap, Pars As Range, _
StrokeIndexen As Range, HoleScores As Range, _
Afgelast As String) As Variant
On Error GoTo FuncFail
Dim Hole As Long
Dim StablefordPuntenRonde As Long
Dim StablefordPunten As Long
If PlayingHandicap = "" Then
WACRondeScore = ""
Exit Function
Else
PlayingHandicap = CLng(PlayingHandicap)
End If
' Afgelast
If Not Afgelast = "" Then
WACRondeScore = "A"
Exit Function
End If
If IsEmptyRange(HoleScores) Then
WACRondeScore = ""
Exit Function
End If
For Hole = 1 To 9
If IsInteger(HoleScores(1, Hole)) Then
StablefordPunten = (Pars(1, Hole) + 2 + Int(((PlayingHandicap * 2) - StrokeIndexen(1, Hole) + 18) / 18)) - HoleScores(1, Hole)
If StablefordPunten < 0 Then StablefordPunten = 0
StablefordPuntenRonde = StablefordPuntenRonde + StablefordPunten
End If
Next Hole
WACRondeScore = StablefordPuntenRonde
Debug.Print "wacRONDESCORE"
Exit Function
FuncFail:
WACRondeScore = CVErr(xlErrValue)
End Function
I think I have found the cause of the recalculation. One of the entry values (PlayingHandicap) seems to be culprit. Don't know why, as yet, but am searching for the bug
This is a segment of code that has been troubling me, as I feel certain some simple function exists that will make looping through the array values redundant.
Instead I have used an array, a loop and a boolean to tell me whether the cells are empty (or test their length) and an If statement to run the last part of the code.
I thought perhaps Max would work but I believe that is only for integers. (See the debug.print part
Dim arrArchLoc As Variant
Dim boolArchLoc As Boolean
Dim rowCounter As Long
boolArchLocEmpty = False
arrArchLoc = ActiveSheet.Range(Cells(2, colArchiveLocation), Cells(lastRow, colArchiveLocation))
For rowCounter = LBound(arrArchLoc) To UBound(arrArchLoc)
If Cells(rowCounter, colArchiveLocation) <> "" Then boolArchLocEmpty = True
Next rowCounter
'Debug.Print workshetfunction.Max(arrArchLoc)
If boolArchLocEmpty = True Then
ActiveSheet.Cells(1, colArchiveLocation).Value = "Arch Loc"
Columns(colArchiveLocation).ColumnWidth = 6
End If
Does such a function or simple method exist?
EDIT:
Whilst that specialcells(xlCellTypeBlanks) solution looks pretty good, I would still rather get the string length solution.
My apologies, the code initially had something like...
If len(Cells(rowCounter, colArchiveLocation)) > 6 then...
but I have since removed it after having to get something in place that would work.
Is there something I could do with LEN(MAX)? I experimented with it but didn't get very far.
Given the range is A2:A100, the result you want would be expressed on the sheet as an array formula:
={MAX(LEN(A2:A100))}
In order to execute that from VBA as an array formula and not a regular formula, you need to use Evaluate:
max_len = Evaluate("=MAX(LEN(A2:A100))")
Or, in terms of your code,
Dim arrArchLoc As Range
With ActiveSheet
Set arrArchLoc = .Range(.Cells(2, colArchiveLocation), .Cells(lastRow, colArchiveLocation))
End With
Dim max_len As Long
max_len = Application.Evaluate("=MAX(LEN(" & arrArchLoc.Address(external:=True) & "))")
However it is much better to calculate it explicitly with a loop, like you were already doing.
Why not something like so
activesheet.range(cells(1,1),cells(10,1)).specialcells(xlCellTypeBlanks)
Another way to check if the range is empty or not
Sub Sample()
Debug.Print DoesRangeHaveEmptyCell(Range("A1:A10")) '<~~ Change as applicable
End Sub
Function DoesRangeHaveEmptyCell(rng As Range) As Boolean
If rng.Cells.Count = Application.WorksheetFunction.CountA(rng) Then _
DoesRangeHaveEmptyCell = False Else DoesRangeHaveEmptyCell = True
End Function
Here is my code
Function copyToNewRange(a As Range, b As Range)
' a is input, b is output
If a.Cells.Count <> b.Cells.Count Then
copyToNewRange = "ERROR"
Exit Function
End If
For i = 1 To a.Cells.Count
b.Cells(i, 1) = a.Cells(i, 1)
Next i
copyToNewRange = "COPIED"
End Function
I would use it thus:
=copyToNewRange(A11:A30,C11:C30)
in a cell not in the input or output range!
Why do I get #VALUE!?
I note that commenting out b.Cells(i, 1) = a.Cells(i, 1) allows it to run, but what is the error in this line?
A UDF (a user defined function, called from a worksheet) cannot directly modify other cells, it can only return a value. There are, however, workarounds.
One such workaround is to construct a call to a Sub as a string, and use Evaluate to execute it.
Something like this:
Function copyToNewRange(rSrc As Range, rDst As Range)
Dim sSub As String
If rSrc.Columns.Count > 1 Or rDst.Columns.Count > 1 Then
copyToNewRange = CVErr(xlErrValue)
ElseIf rSrc.Rows.Count <> rDst.Rows.Count Then
copyToNewRange = CVErr(xlErrValue)
Else
sSub = "copyToNewRangeSub(" & _
rSrc.Address(True, True, xlA1, True) & "," & _
rDst.Address(True, True, xlA1, True) & ")"
rSrc.Worksheet.Evaluate sSub
copyToNewRange = vbNullString
End If
End Function
Sub copyToNewRangeSub(rSrc As Range, rDst As Range)
rDst.Value = rSrc.Value
End Sub
Note, there are several other issues in your code I have addressed
When you want your function to return an err, return an ... Error
To ensure the ranges are shaped correctly, counting cells alone is not enough
Don't loop over a range, copy it in one go.
Your function should return something
You should Dim all your variables (use Option Explicit to force this)
Use meaningfull parameter names
Thanks to Tim Willaims for the concept
In a worksheet, you can't use a function that DOES things. Only one that returns data. That is quite logical, since the function is evaluated every time the sheet changes.
If you really want that behaviour, use the Worksheet_Change event.
Also note that, in your example, it is very uneffective to copy cells 1 by 1, compared to copy a range at once.
I use check boxes on individual worksheets to set ranges for performing VLookup functions. One of the check boxes needs to set two distinct ranges in which to search. I'm out of ideas on how to make this work. All the other possible variants are searching a continuous string of cells (i.e. [S9:T20] or [S55:T66] but not both. If I end up having to u multiple variables and perform the function twice the rest of my code will probably not work. Any ideas would be appreciated including if some sort of Find function might do similar work.
Below are snippets of the code that I use:
Dim rngO As Variant
ElseIf ActiveSheet.Shapes("Check Box 43").ControlFormat.Value = 1 Then
rngO = [S9:T20;S55:T66]
The rngO variant is used as shown below (one example):
Case 2
With ActiveSheet
.Range("U2").Value = "1Y"
.Range("V2").Value = WorksheetFunction.VLookup("1Y", rngO, 2, False)
.Range("U3").Value = "1P"
.Range("V3").Value = WorksheetFunction.VLookup("1P", rngO, 2, False)
.Range("U4").Value = "."
.Range("V4").Value = "."
short answer: Yes - it is!
longer answer:
You wrap the WorksheetFunction.VLookup() by some code looking at each area of your source range individually.
Function MyVLookup(Arg As Variant, Source As Range, ColNum As Integer, Optional CmpSwitch As Boolean = True) As Variant
Dim Idx As Integer
MyVLookup = CVErr(xlErrNA) ' default return value if nothing found
On Error Resume Next ' trap 1004 error if Arg is not found
For Idx = 1 To Source.Areas.Count
MyVLookup = WorksheetFunction.VLookup(Arg, Source.Areas(Idx), ColNum, CmpSwitch)
If Not IsError(MyVLookup) Then Exit For ' stop after 1st match
Next Idx
End Function
and in your original code replace all calls to WorksheetFunction.VLookup() by calls to MyVLookup() with the same parameters.
Alternatively you can use this function directly in a cell formula (that's what I usually do with it ...)
I'm trying to write a function that merges multiple rows of text in a column into a single cell based on a pre determined count. My goal is to generate a flexible function to aid in compiling / interperting large quantaties of data. The code I've written returns #NAME? and I cant figure out where the error is. My code is as follows:
Function vmrg(countref As Integer, datref As Integer) As String
If IsEmpty(ActiveCell.Offset(0, -countref)) Then % check if cell containing count is blank
vertmerge = "N/A" % if blank, state N/A
Else
Dim datlst(0 To ActiveCell.Offset(0, -countref).Value - 1) As String
Dim i As Integer
For i = 0 To ActiveCell.Offset(0, -countref).Value - 1
datlst(i) = ActiveCell.Offset(i, -datref).Text %fill array with data
End
vertmerge = datlst(0)
For i = 1 To ActiveCell.Offset(0, -countref).Value - 1 % merge array to a single string
vertmerge = vertmerge & ", " & datlst(i)
End
End
End Function
I have matlab and some C++ experience but this is the first time I've used VBA so my syntax is probably odd in some areas and wrong in others. Ideally I would like to reference the cells where the data and count info are stored, but for now I'm hoping to correct my syntax and set a jumping off point for further development of this function. Any reccomendations are appreciated.
Code Rev_1: I still have an output of #NAME? but I think I've corrected(?) some of the issues
Function vertmerge(countref As Range, datref As Integer) As String
If IsEmpty(countref) = True Then
vertmerge = "NA"
Else
Dim datlst(0 To countref.Value - 1) As String
Dim i As Integer
For i = 0 To countref.Value - 1
datlst(i) = countref.Offset(i, datref).Text
Next i
vertmerge = datlst(0)
For i = 1 To countref.Value - 1
vertmerge = vertmerge & ", " & datlst(i)
Next i
End
End Function
You are doing some dangerous things here!
First - you are referencing "ActiveCell" from inside a function; but you have NO IDEA what cell will be active when the function runs! Instead, pass the target cell as a parameter:
=vmrg("B6", 5, 6)
and change your function prototype to
Function vmrg(r as Range, countref as Integer, datref as Integer)
Now you can reference things relative to r with
r.Offset(1,2)
etc.
Next - you are never assigning anything to vmrg. In VBA, the way a function returns a value is with (in this case)
vmrg = 23
You are assigning things to a variable called vertmerge - but that is not the name of your function. At least add
vmrg = vertmerge
Just before returning. That might do it. Without a full sample of your spreadsheet I can't help you more.