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.
Related
I have written a function that checks cell to be crossed out:
Function isCrossedout(myRange As Range)
isCrossedout = myRange.Font.Strikethrough
End Function
and I have a column "A:A" of numbers where I want to sum up crossed out elements only.
Can I insert in any cell the standard function SUMIFS with my user defined function?
When I try this:
someCell.FormulaR1C1 = "=SUMIFS('Page'!RC1:RC1, isCrossedout)"
it returns zero value when the formula applied.
I realize there is a way to use summing such cells in a pure VBA way with a loop, but I want to try to use it with Excel SUMIFS formula.
First, you need isCrossedout to return a boolean array. Font.Strikethrough will not return an array, so use a loop:
Function isCrossedout(ByVal myRange As Range) As Boolean()
Dim arr() As Boolean
ReDim arr(1 To myRange.Rows.Count, 1) ' assumes myRange has one column
Dim cell As Range
For Each cell In myRange
Dim counter As Long
counter = counter + 1
arr(counter, 1) = cell.Font.Strikethrough
Next
isCrossedout = arr
End Function
Next, I'd use SUMPRODUCT, with the double unary -- to coerce the boolean array to an array of ones and zeros.
=SUMPRODUCT(A2:A5*--isCrossedout(A2:A5))
For a version that can handle a multi-column input:
Function isCrossedout(myRange As Range) As Boolean()
Dim arr() As Boolean
ReDim arr(1 To myRange.Rows.Count, 1 To myRange.Columns.Count)
Dim i As Long, j As Long
For i = 1 To myRange.Rows.Count
For j = 1 To myRange.Columns.Count
arr(i, j) = myRange.Cells(i, j).Font.Strikethrough
Next
Next
isCrossedout = arr
End Function
I am attempting to practice my VBA skills by coding the equivalent of SUMX2MY2 in my own function, mySUMX2MY2 (I realize I could use =SUMPRODUCT but I'm practicing functions). I'm trying to do it by creating two arrays from whatever ranges are selected and squaring the ranges and minus the second squared range. Each time I try in excel, I get the error #VALUE. My guess is the error is with the argument my function is returning but I'm not sure how to fix it.
Sub main()
End Sub
Function mySumX2MY2(n1 As Range, n2 As Range) As Variant
Dim n1Array() As Variant
Dim n2Array() As Variant
Dim total As Variant
Dim i As Integer
Dim aCell As Variant
i = 1
ReDim n1Array(n1.Count)
ReDim n2Array(n2.Count)
For Each aCell In n1
n1Array(i) = aCell.Value
i = i + 1
Next
For Each aCell In n2
n2Array(i) = aCell.Value
i = i + 1
Next
i = 1
For i = 1 To n1.Rows.Count
total = total + (n1Array(i) * n1Array(i) - n2Array(i) * n2Array(i))
i = i + 1
Next
mySumX2MY2 = total
End Function
My Excel worksheet row cells contain a mixed collection of data types -- numbers, alphas, and errors (e.g., #REF!). I want to pass this range to a function which finds the max number only and ignores the alphas and errors. My code:
Public Function getRangeMax(passedRange As range) As Single
'validate entries in passed range as numbers or skip
'return max from validated numbers
Dim i As Integer, arryLength As Integer
Dim arry()
getRangeMax = 0
arry() = passedRange
arryLength = UBound(arry) - LBound(arry)
For i = 0 To arryLength
On Error Resume Next
If arry(i).value > getRangeMax Then
getRangeMax = arry(i).value
End If
Next i
'getRangeMax = Application.Max(passedRange)
End Function
The function call is: =getRangeMax(C35:I35). The data in that particular range of cells is: dB, 456.00, #REF!, 12. I would expect the code to ignore the dB and #REF! entries and return the maximum number, which in this case is 456.00. Instead, the function returns 0.00. What am I doing wrong?
Your code contains multiple errors, all hidden from you by the always active On Error Resume Next
Here's your code refactored to fix the errors and with an alternative type check
Public Function getRangeMax(passedRange As Range) As Double
'validate entries in passed range as numbers or skip
'return max from validated numbers
Dim i As Long, j As Long
Dim item As Variant
Dim arry()
getRangeMax = 0
arry() = passedRange
For i = 1 To UBound(arry, 1)
For j = 1 To UBound(arry, 2)
item = arry(i, j)
If VarType(item) = vbDouble Then
If item > getRangeMax Then
getRangeMax = item
End If
End If
Next j, i
End Function
Note:
Using VarType to test for valid items to process will result in any cells that are Text but look like numbers to be ignored.
Using IsNummeric to test for valid items to process will result in any cells that are Text but look like numbers to be converted to numbers and included in the test.
Try this:
Public Function Rng_Max_Get(rTrg As Range) As Double
Dim aTrg As Variant, vItm As Variant, blTrg As Boolean
aTrg = rTrg.Value2
For Each vItm In aTrg
If IsNumeric(vItm) Then
If vItm <> Empty Then
If blTrg Then
If vItm > Rng_Max_Get Then Rng_Max_Get = vItm
Else
blTrg = True
Rng_Max_Get = vItm
End If: End If: End If: Next
End Function
Since you are inputting a rectangular Range, you can use the .Rows.Count and .Columns.Count instead of deriving from UBound. Try this:
Option Explicit
Function getRangeMax(passedRange As Range) As Double
'validate entries in passed range as numbers or skip
'return max from validated numbers
Dim lRows As Long, lCols As Long, lR As Long, lC As Long
Dim uValue As Double, uMax As Double
Dim arry() As Variant
arry = passedRange
lRows = passedRange.Rows.Count
lCols = passedRange.Columns.Count
uMax = 0
For lR = 1 To lRows
For lC = 1 To lCols
If IsNumeric(arry(lR, lC)) Then
uValue = CDbl(arry(lR, lC))
If uValue > uMax Then uMax = uValue
End If
Next
Next
getRangeMax = uMax
End Function
I am trying to count the number of cells in a range that has the same color as a reference cells, IF the corresponding cell in another range has the correct value criterion. For example:
If (A1 < 350) and (B1 has the same color as a reference cell), then count 1.
Loop over rows 1 to 15
It is essentially the same problem as the question posted here:
http://www.mrexcel.com/forum/excel-questions/58582-countif-multiple-criteria-one-being-interior-color.html
Unfortunately, it seems that the ExtCell.zip file no longer exit. Hence, I could not simply replicate the given solution. I tried to follow the same approach using the SUMPRODUCT function and I wrote a function for comparing cell color, but it did not work. I got the error "A value used in the formula is of the wrong data type." My code is as follow. I am using Excel 2007 on Windows 7. Any help is appreciated. Thanks!
=SUMPRODUCT((B57:B65<350) * (ColorCompare(D307,D57:D65)))
The formula above is keyed into a cell. B57:B65 contain some numerical values, while D57:D65 are colored cells. D307 is the reference cell with the correct color.
'' VBA function ColorCompare
Function ColorCompare(refCell As Range, compareCells As Range) As Variant
Dim rCell As Range
Dim TFresponses() As Boolean 'the boolean array to be returned to SUMPRODUCT
Dim CallerCols As Long 'find out the number of cells input by the user
'so as to define the correct array size
With Application.Caller
CallerCols = .Column.Count
End With
ReDim TFresponses(1 To CallerCols)
Dim Idx As Long
Idx = 1
For Each rCell In compareCells
If rCell.Interior.ColorIndex = refCell.Interior.ColorIndex Then
TFresponses(Idx) = 1
Idx = Idx + 1
Else
TFresponses(Idx) = 0
Idx = Idx + 1
End If
Next rCell
ColorCompare = TFresponses
End Function
There are a couple of issues in your code
You need to determine the size of compareCells, not the caller cell
You are considering columns, should be Rows (or Rows and Columns for maximum flexability)
There are a few optimisations you can make
Here's a refactored version of your Function
Function ColorCompare(refCell As Range, compareCells As Range) As Variant
Dim rCell As Range, rRw As Range
Dim TFresponses() As Boolean 'the boolean array to be returned to SUMPRODUCT
Dim rw As Long, cl As Long
Dim clr As Variant
clr = refCell.Interior.ColorIndex
ReDim TFresponses(1 To compareCells.Rows.Count, 1 To compareCells.Columns.Count)
rw = 1
For Each rRw In compareCells.Rows
cl = 1
For Each rCell In rRw.Cells
If rCell.Interior.ColorIndex = clr Then
TFresponses(rw, cl) = True
End If
cl = cl + 1
Next rCell
rw = rw + 1
Next rRw
ColorCompare = TFresponses
End Function
Note that while this will return a result for any shaped range, to be useful in SumProduct pass it a range either 1 row high or 1 column wide - just as your sample formula does.
Try this (updated for given formula: =SUMPRODUCT((B57:B65<350) * (ColorCompare(D307,D57:D65)))):
Sub test()
i = 57
While Not IsEmpty(Cells(i, 1))
If Cells(i, 2) < 350 And Cells(i, 4).Interior.ColorIndex = Cells(307, 4).Interior.ColorIndex Then 'replace with your reference cell
count = count + 1
End If
i = i + 1
Wend
End Sub
I'm getting Error '424': Object Required When I try to run the following subroutine:
Sub MySub()
'Iterate through column, setting corresponding values
For Each cell In Range("Table5[Name]")
cell.Offset(, 2).Value = Avg("Table2[time]", cell.Value, "Table2[name]")
cell.Offset(, 3).Value = StDev("Table2[time]", cell.Value, "Table2[name]", cell.Offset(, 2).Value)
Next
End Sub
When I press debug, it highlights the second line inside the For loop. Both Avg and StDev are functions I wrote to work similarly to AVERAGEIF, but in a very specific scenario.
The Avg function works exactly as intended, and StDev is almost identical. It has one extra If statement, and the math is almost identical. Both functions return a Variant.
I can't figure out why it's doing this. So far I've tried adding Set in front of the troublesome line (I knew it wouldn't work, but I had to try anyway), and I've made sure both functions are safe (i.e. they do not divide by zero, and they always return a value).
Here's the StDev function (modified to protect work confidentiality, but has same issue):
Function StDev(rng As Range, Criteria1 As Variant, Criteria_Rng1 As String, Optional avg As Variant) As Variant
'Call like this
' StDev2Ifs(Range to StDev, Match this, Range to find Criteria1, [average])
If IsMissing(avg) Then
avg = Avg(rng, Critera1, Criteria_Rng1)
End If
If avg <> "NO DATA" Then
'Convert Strings to Ranges
Dim c_rng, c_rng1 As Range
Set c_rng = Application.Range(rng)
Set c_rng1 = Application.Range(Criteria_Rng1)
'Get Column Indices
Dim r, r1As Long
r = c_rng.Columns(c_rng.Columns.Count).Column
r1 = c_rng1.Columns(c_rng1.Columns.Count).Column
'Calculate column offsets from range to stdev
Dim off1 As Long
off1 = r1 - r
'x will be used to sum the elements
Dim x As Double
x = 0
'ct will be used to count number of elements
Dim ct As Double
ct = 0
For Each cell In Range(rng)
If cell.Offset(, off1).Value = Criteria1 Then
x = x + Square(cell.Value - avg)
ct = ct + 1
End If
Next
'Divide by count
If ct <> 0 Then
StDev = x / ct
Else
StDev = "NO DATA"
End If
'Square Root
If ct <> 0 Then
StDev = StDev ^ (1 / 2)
End If
Else
StDev = "NO DATA"
End If
End Function
Anybody have any ideas?
cell.Offset(, 3).Value = StDev("Table2[time]", cell.Value, "Table2[name]", cell.Offset(, 2).Value)
in the first code block should be
cell.Offset(, 3).Value = StDev(Range("Table2[time]"), cell.Value, "Table2[name]", cell.Offset(, 2).Value)
if you intend to pass a range as the function expects. You will run to an error tough because in your function StDev seems to be built for it to be passed as string so I suggest that you correct your function from
Function StDev(rng As Range, Criteria1 As Variant, Criteria_Rng1 As String, Optional avg As Variant) As Variant
to
Function StDev(rng As String, Criteria1 As Variant, Criteria_Rng1 As String, Optional avg As Variant) As Variant
Quick check so be careful, I might have missed something.