I want to prevent NaN values when i preview my report (ssrs).
I used custom code.
Public Dim TotalAmount As Double = 0
Public Dim ThisValue As Double = 0
Public Dim SValue As Double = 0
Public Dim TValue As Double = 0
Public Function CalculateTotal(FirstValue as Double,SecondValue as Double,
ThirdValue as Double) as Double
ThisValue=ThisValue+FirstValue
SValue=Svalue+SecondValue
TValue=TValue+ThirdValue
TotalAmount=SValue/(ThisValue+TValue)*100
Return TotalAmount
End Function
In my expression:
=Code.CalculateTotal(Fields!N_ANSWERED.Value,Fields!SLA.Value,Fields!N_ABANDONED.Value)
I tried with prevent dividing by zero :
IIF((ThisValue+TValue)*100=0,1,(ThisValue+TValue)*100)
, but nothing change.
I expected zero values.
I would just add an If to check for a zero denominator on your TOTAL calculation.
Public Dim TotalAmount As Double = 0
Public Dim ThisValue As Double = 0
Public Dim SValue As Double = 0
Public Dim TValue As Double = 0
Public Function CalculateTotal(FirstValue as Double, SecondValue as Double, ThirdValue as Double) as Double
ThisValue = ThisValue + FirstValue
SValue = Svalue + SecondValue
TValue = TValue + ThirdValue
If ThisValue + TValue <> 0 Then TotalAmount = SValue / (ThisValue + TValue) * 100
Return TotalAmount
End Function
This way, if your total is 0, it doesn't perform the Total Amount calculation.
The IIF that you had was SSRS Expression Syntax not VBA syntax that was probably giving a different error.
Related
I developed some code for an Access Database that manipulates a string with a statement like:
myString = Left(myString, somePosition) & Right(myString, someOtherPosition)
the above is part of a loop that has thousands of iterations and the variable myString is thousand of characters long.
I know the above code is bad practice in Java and a StringBuffer should be used instead of a string.
My code is taking a lot of time to run (about 7 minutes) and I suspect the problem might be related to the heavy string manipulation that is going on. Can you please confirm if there is anything similar to StringBuffer in VBA that could improve the efficiency of my code?
Update: full code with StringBuilder
Function SelectColumns2(str As String, columns As String, separator As String) As String
'column_number is the number of the column we are reading when we loop through a line
'z is the counter of the field (a portion of str between two separators)
'i is the counter of the str (the position of the modified string)
Dim column_number As Integer, i As Double, z As Integer, leftPosition As Double
'stringbuilder that stores the string that will represent the final file
Dim sb As StringBuilder, leftStr As StringBuilder, rightStr As StringBuilder
Set sb = New StringBuilder
Set leftStr = New StringBuilder
Set rightStr = New StringBuilder
sb.Append str
column_number = 1
i = 1 ' full str
z = 0 ' full field
While sb.Length >= i
z = z + 1
If Mid(sb.Text, i, 1) = separator Then
If InStr(1, columns, "/" & column_number & "/") = 0 Then
leftStr.Append left(sb.Text, i - z)
rightStr.Append right(sb.Text, sb.Length - i)
sb.Clear
sb.Append leftStr.Text
sb.Append rightStr.Text
leftStr.Clear
rightStr.Clear
i = i - z
End If
column_number = column_number + 1
z = 0
ElseIf Mid(sb.Text, i, 1) = Chr(10) Then
If InStr(1, columns, "/" & column_number & "/") = 0 Then
leftPosition = max((i - z - 1), 0)
If leftPosition = 0 Then
leftStr.Append left(sb.Text, leftPosition)
rightStr.Append right(sb.Text, sb.Length - i)
sb.Clear
sb.Append leftStr.Text
sb.Append rightStr.Text
Else
leftStr.Append left(sb.Text, leftPosition)
rightStr.Append right(sb.Text, sb.Length - i + 1)
sb.Clear
sb.Append leftStr.Text
sb.Append rightStr.Text
End If
leftStr.Clear
rightStr.Clear
i = i - z
End If
column_number = 1
z = 0
End If
i = i + 1
Wend
SelectColumns2 = left(sb.Text, sb.Length - 1)
End Function
You can use CreateObject to create the .Net stringbuilder class. Note that you will have to have the relevant .Net library installed, and VBA does not support overloading, so it will handle a little differently than in VB.Net.
Sample code:
Public Sub TestSB()
Dim sb As Object
Set sb = CreateObject("System.Text.StringBuilder")
sb.Append_3 "Hello"
sb.Append_3 " "
sb.Append_3 "World"
sb.Append_3 "!"
Debug.Print sb.ToString
End Sub
Alternatively, you can build your own stringbuilder. This answer provides a stringbuilder class, and this question also shows some sample code.
You can - for an extremely simple implementation - use Mid.
For example, this code runs in about 0.1 ms for the quite large strings entered:
Public Function ChopString() As String
Dim Source As String
Dim LeftPart As Long
Dim RightPart As Long
Dim Result As String
Source = String(100000, "x")
LeftPart = 30000
RightPart = 40000
Result = Space(LeftPart + RightPart)
Mid(Result, 1) = Left(Source, LeftPart)
Mid(Result, 1 + LeftPart) = Right(Source, RightPart)
ChopString = Result
End Function
For smaller strings of a few K, it runs way faster.
I am using below code for finding partitions for a given number (N). How can I ensure only unique partitions? For instance partitions (1, 1, 1, 7), (1, 1, 7, 1), (1, 7, 1, 1) and (7, 1, 1, 1) would be considered the same and only one of these should be output.
Thanks
Regards
Dim N = 10
For i As Integer = 0 To N
For j As Integer = 0 To N
For k As Integer = 0 To N
For l As Integer = 0 To N
If i + j + k + l = N Then
Dim St As String = String.Format("({0:d}, {1:d}, {2:d}, {3:d})", i, j, k, l)
Console.WriteLine(St)
End If
Next
Next
Next
Next
Console.Read()
EDIT: Below seems to be working from someone's suggestion;
Module Module1
Sub Main()
Console.WriteLine("Please enter an integer.")
Dim sReadLine As String = Console.ReadLine()
Dim iValue As Integer
If IsNumeric(sReadLine) Then
iValue = CInt(sReadLine)
Else
Console.WriteLine("'" & sReadLine & "' is not a numeric value. Press any key to exit.")
'Application.Exit()
Console.Read()
Exit Sub
End
End If
Console.Clear()
Console.WriteLine("Number is {0}", iValue)
Console.WriteLine("")
Partitions1(iValue)
Exit Sub
End Sub
Dim partitions As New List(Of Part)
Private Sub Partitions1(N As Integer)
For i As Integer = 0 To N
For j As Integer = 0 To N
For k As Integer = 0 To N
For l As Integer = 0 To N
If i + j + k + l = N Then
Dim thisPartition As New Part()
thisPartition.Parts = New Integer() {i, j, k, l}
If Not partitions.Contains(thisPartition) Then
partitions.Add(thisPartition)
End If
End If
Next
Next
Next
Next
For Each x In partitions
Dim St = "("
For Each y In x.Parts
St = St & y & ", "
Next
St = Left(St, Len(St) - 2)
St = St & ")"
Console.WriteLine(St)
Next
Console.WriteLine("")
Console.WriteLine("{0} unique partititons found.", partitions.Count)
Console.Read()
End Sub
Public Class Part 'Sorted array of integer with comparer
Implements IEquatable(Of Part)
Public Property Parts As Integer()
Get
Return m_Parts
End Get
Set(value As Integer())
m_Parts = value
Array.Sort(m_Parts)
End Set
End Property
Private m_Parts As Integer()
Public Overloads Function Equals(other As Part) As Boolean _
Implements IEquatable(Of Part).Equals
If other Is Nothing Then
Return False
End If
If other.Parts.GetLength(0) <> m_Parts.GetLength(0) Then Return False
Dim result As Boolean = True
Array.Sort(other.Parts)
For I As Integer = 0 To other.Parts.GetLength(0) - 1
If other.Parts(I) <> m_Parts(I) Then
result = False
Exit For
End If
Next
Return result
End Function
' Should also override == and != operators.
End Class
End Module
Collect the found solutions in a list, then writen an algo which eliminates the duplicates from the list and then print the list.
I have a simple function using Excel VBA for calculating volatility. It takes as inputs a column of numbers (Zeros) and two dates. The code is:
Function EWMA(Zeros As Range, Lambda As Double, MarkDate As Date, MaturityDate As Date) As Double
Dim vZeros() As Variant
Dim Price1 As Double, Price2 As Double
Dim SumWtdRtn As Double
Dim I As Long
Dim m As Double
Dim LogRtn As Double, RtnSQ As Double, WT As Double, WtdRtn As Double
vZeros = Zeros
m = Month(MaturityDate) - Month(MarkDate)
For I = 2 To UBound(vZeros, 1)
Price1 = Exp(-vZeros(I - 1, 1) * (m / 12))
Price2 = Exp(-vZeros(I, 1) * (m / 12))
LogRtn = Log(Price1 / Price2)
RtnSQ = LogRtn ^ 2
WT = (1 - Lambda) * Lambda ^ (I - 2)
WtdRtn = WT * RtnSQ
SumWtdRtn = SumWtdRtn + WtdRtn
Next I
EWMA = SumWtdRtn ^ (1 / 2)
End Function
The main feature enabling the function to work is the For loop. I want to re-create this in Access VBA using recordset objects. The recordset has the same fields as the Excel spreadsheet. I'm not exactly sure how to convert the code over, though. Here is what I have so far:
Function EWMA(rsCurve As Recordset, InterpRate As Double, Lambda As Double) As Double
Dim vZeros() As Variant
Dim Price1 As Double, Price2 As Double
Dim SumWtdRtn As Double
Dim I As Long
Dim mat As Date
Dim mark As Date
Dim LogRtn As Double, RtnSQ As Double, WT As Double, WtdRtn As Double
CurveInterpolateRecordset = Rnd()
If rsCurve.RecordCount <> 0 Then
vZeros = CVar(rsCurve.Fields("CurveInterpolateRecordset"))
mat = CDate(rsCurve.Fields("MaturityDate"))
mark = CDate(rsCurve.Fields("MarkDate"))
m = Month(mat) - Month(mark)
For I = 2 To UBound(vZeros, 1)
Price1 = Exp(-vZeros(I - 1, 1) * (m / 12))
Price2 = Exp(-vZeros(I, 1) * (m / 12))
LogRtn = Log(Price1 / Price2)
RtnSQ = LogRtn ^ 2
WT = (1 - Lambda) * Lambda ^ (I - 2)
WtdRtn = WT * RtnSQ
SumWtdRtn = SumWtdRtn + WtdRtn
Next I
EWMA = SumWtdRtn ^ (1 / 2)
End If
Debug.Print EWMA
End Function
The function is called in an earlier subroutine in Access. What am I missing in order to move through the recordset in Access, similar to looping through the spreadsheet in Excel VBA?
The easiest method would be to use GetRows to pull an array from your recordset:
Recordset.GetRows Method
Then the new code would be nearly a copy-n-paste of your proven code starting with basically this:
vZeros = rsCurve.GetRows(rsCurve.RecordCount)
As a side note you wouldn't need CDate here:
mat = rsCurve.Fields("MaturityDate").Value
Here are some basics about using a recordset.
Dim rs As New ADODB.Recordset
'Add fields to your recordset for storing data.
With rs
.Fields.Append "Row", adInteger
.Fields.Append "ColumnName2", adChar, 30
.Fields.Append "ColumnName3", adInteger
.Open
End With
Add records to it manually
rs.AddNew
rs.Fields("Row").Value = 1
rs.Fields("ColumnName2").Value = "Put some value in"
rs.Update
rs.AddNew
rs.Fields("Row").Value = 2
rs.Fields("ColumnName2").Value = "Put another value in"
rs.Update
You can also populate it with a query of a table.
Move to the begining of the recordset
If rs.EOF = False Then
rs.MoveFirst
End If
Loop through the recordset
Do While rs.EOF = False
msgbox(rs.Fields("ColumnName2").Value)
rs.MoveNext
Loop
I have the following code, I am trying to subtract .5 from the text53 object if the date value is higher than 15, but I keep getting the error "Invalid Use of property" error
Private Sub Report_Load()
Dim Maxdate As Integer, LValue As Integer, LValue2 As Integer
Dim Mvalue As Integer, Dvalue As Date, RateVal As Integer
LValue2 = 0.5
RateVal = Me.Text31.Value * Me.Text27.Value
Dvalue = Me.Text43
Mvalue = DateDiff("m", Me.Text41, Me.Text43)
If Format(Dvalue, "DD") >= 15 Then Me.Text53 - LValue2
Me.Text53 = Mvalue
Me.Text51 = Me.Text53 * RateVal
End Sub
Try this:
Private Sub Report_Load()
Dim Maxdate As Integer
Dim LValue As Integer
Dim LValue2 As Single
Dim Mvalue As Integer
Dim Dvalue As Date
Dim RateVal As Integer
LValue2 = 0.5
RateVal = Me.Text31.Value * Me.Text27.Value
Dvalue = Me.Text43
Mvalue = DateDiff("m", Me.Text41, Me.Text43)
Me.Text53 = Mvalue
If Format(Dvalue, "DD") >= 15 Then
Me.Text53 = Me.Text53 - LValue2
End If
Me.Text51 = Me.Text53 * RateVal
End Sub
I think your main problem is this: Me.Text53 - LValue2
You need to assign that value to something. By itself it will only produce errors. Changing that line to Me.Text53 = Me.Text53 - LValue2 or Me.Text53 = Mvalue - LValue2 would fit the bill.
Other things of note: you can't assign a decimal to an integer datatype, it'll round it to a whole number. Also, assigning Mvalue to Text53 needs to happen before your conditional subtraction of 0.5 or that part will just get overwritten.
I have a stupid question, I always got the error type mismatch when I created a function which return a array. here are two simple example :
if I don't declare the type when declaration: It will be compiled, but got the error after the function result
Function aa(c As Integer)
Dim arr(10)
Dim i As Integer
Dim k As Double
For i = 0 To 10
k = i ^ 2 / c + 1
arr(i) = CStr(k)
Debug.Print k
Next i
aa = arr
End Function
if i declare the type: it can't be compiled and will get the error directly
Function aa(c As Integer) as string()
Dim arr(10) as string
Dim i As Integer
Dim k As Double
For i = 0 To 10
k = i ^ 2 / c + 1
arr(i) = CStr(k)
Debug.Print k
Next i
aa = arr
End Function
Your second version will work if you call it this way, using the same type:
Sub Testaa()
Dim result() As String
result = aa(4)
End Sub
Your first version will return a Variant - any function (or variable) that isn't given a specific type will default to Variant. So you need to store the return result in a Variant as well:
Sub Testaa()
Dim result As Variant
result = aa(4)
End Sub
It is preferable to use explicit types wherever possible.