Javascript converted to Excel VB Function Produces #NUM! error - excel

Hey guys, I have a javascript function that produces a 12 digit UPC code (Based on the first 11 digits:
function ccc12(rawVal) {
factor = 3;
sum = 0;
rawVal = rawVal.toString();
if (rawVal.length!=11){
throw "The UCC-12 ID Number requires that you enter 11 digits.";
}
for (index = rawVal.length; index > 0; --index) {
sum = sum + rawVal.substring (index-1, index) * factor;
factor = 4 - factor;
}
return ((1000 - sum) % 10);
}
Assuming the above if I gave 84686400201 as the rawVal, then 2 would be the outcome returned.
This was then converted to
Function generateUPC(upcCode As Integer) As String
Dim upcCheckDigit, factor, sum As Integer
Dim upcString As String
factor = 3
sum = 0
For i = Len(upcCode) To 0 Step -1
sum = sum + Mid(upcCode, i - 1, 1) * factor
factor = 4 - factor
Next i
upcCheckDigit = ((1000 - sum) Mod 10)
upcString = upcCode & upcCheckDigit
generateUPC = upcString
End Function
This function returns the original string plus the last digit, but instead i get #NUM! in the worksheet when I put =generateUPC(84686400201) into the cell.
Any ideas? Never really bothered doing VB Macros etc before so this is new to me

I suggest changing upcCode to a string to avoid overflow and changing the indexes of your loop and within the Mid function to avoid out-of-bounds errors.
Function generateUPC(upcCode as String) As String
Dim upcCheckDigit, factor, sum As Integer
Dim upcCode, upcString As String
factor = 3
sum = 0
For i = Len(upcCode) To 1 Step -1
sum = sum + Mid(upcCode, i, 1) * factor
factor = 4 - factor
Next i
upcCheckDigit = ((1000 - sum) Mod 10)
upcString = upcCode & upcCheckDigit
generateUPC = upcString
End Function

VBA integers are -32k to +32k
VBA Longs are -2B to +2B
Your 'upcCode' integer is larger than the long data type so I tried it with Double, which is a float, but works:
Function generateUPC(upcCode As Double) As String
Dim upcCheckDigit, factor, sum As Double
Dim upcString As String
factor = 3
sum = 0
For i = Len(upcCode) To 0 Step -1
sum = sum + Mid(upcCode, i - 1, 1) * factor
factor = 4 - factor
Next i
upcCheckDigit = ((1000 - sum) Mod 10)
upcString = upcCode & upcCheckDigit
generateUPC = upcString
End Function

Related

What does this Excel VBA function do?

I don't know how to read VBA (excel). Can you help me and translate this function?
Function calculateDigit(value)
lenval = Len(value)
factor = 3
Sum = 0
For Index = lenval To 1 Step -1
Sum = Sum + (CInt(Mid(value, Index, 1)) * factor)
factor = 4 - factor
Next
calculateDigit = ((1000 - Sum) Mod 10)
End Function

Truncating 2 Strings and combined into smaller String [closed]

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 5 years ago.
Improve this question
So, I have two strings that are each a max length of 100.
Dim a as String ''has a max length of 100
Dim b as String ''has a max length of 100
These two strings need to be truncated and combined into a new string.
Dim c as String 'has a max length of 100
I need to be able to truncate each string appropriately so that I can get string c as close to 100. I was going to do a bunch of statements by 25 to truncate each one.
if a.length = 100 and b.length =0 then
return a
else if a.length = 100 andalso b.length <= 25 then
return a.truncate(75) & b
else if a.length = 100 andalso b.length <= 50 then
return a.truncate(50) & b
else if....
and so one to hit all the scenarios...
I feel like there is a better way to do this and a more efficient way so that i may not hit scenarios like a.length = 100 and b.length = 51. I would be truncating more characters then needed.
Any suggestions?? Please critique me as needed.
EDIT, This is vb.Net..not C# (I'm between Projects) Sorry!
The reason i do not want to just add them together and truncate them is because if both strings are 100 in length, it will completely truncate off the second string. If they are both 100 then I would want to truncate string a to 50 in length and string b to 50 in length so when they are combined they are 100 total. In other words I need some text from both strings.
If the total length of the strings is greater than the limit then you could take a fraction of each in proportion to their lengths:
Module Module1
Function CombineWithLengthConstraint(a As String, b As String, totalLength As Integer) As String
' trivial case 1:
If totalLength < 1 Then
Return String.Empty
End If
Dim aLen = Len(a)
Dim bLen = Len(b)
' trivial case 2:
If aLen + bLen <= totalLength Then
Return a & b
End If
' impossible-to-satisfy-equably case:
If totalLength = 1 Then
If aLen > 0 Then
Return a.Substring(0, 1)
ElseIf bLen > 0 Then
Return b.Substring(0, 1)
Else
Return String.Empty
End If
End If
' aportion the lengths of the strings to be taken in the ratio of their lengths:
Dim aFrac = CInt(Math.Round(aLen / (aLen + bLen) * totalLength, MidpointRounding.AwayFromZero))
Dim bFrac = CInt(Math.Round(bLen / (aLen + bLen) * totalLength, MidpointRounding.AwayFromZero))
' ensure there is at least one character from each string...
If aFrac = 0 Then
aFrac = 1
bFrac -= 1
End If
If bFrac = 0 Then
bFrac = 1
aFrac -= 1
End If
Dim aPart = a.Substring(0, aFrac)
Dim bPart = b.Substring(0, bFrac)
Return aPart & bPart
End Function
Sub Main()
Dim a = New String("A"c, 10)
Dim b = New String("b"c, 40)
Dim c = CombineWithLengthConstraint(a, b, 10)
Console.WriteLine(c)
Console.WriteLine(Len(c))
Console.ReadLine()
End Sub
End Module
Outputs:
AAbbbbbbbb
10
As you can see, the first string, which was 1/5 of the total number of characters, ended up contributing 1/5 of the result.
The VB.NET Len function gives 0 if its argument is Nothing.
I tested it as working with all lengths from 0 to 100 of both strings being combined into one string of length 100 just in case I had made a mistake with the rounding or anything.
Of course, you could return, say, the ending part of string b instead of the starting part if that made sense in the particular application.
Although not exactly what you asked for, here's another option...
Public Function WeirdConcatinate(a As String, b As String) As String
Dim totalLen = a.Length + b.Length
If totalLen > 100 Then
Dim aLen = 100 * a.Length \ totalLen
Dim bLen = 100 - aLen
Return a.Remove(aLen) & b.Remove(bLen)
Else
Return a & b
End If
End Function
This will give you a number of characters from each string (approximately) proportional to how long they are compared to each other. If both strings are the same length, you'll get 50 from each. If a.Length = 100 and b.Length = 50, you'll end up with 66 from a and 34 from b.
Truncate them after concatenating them, then:
Dim c = a & b
If c.Length > 100 Then c = c.Remove(100)
If you want to preserve as much as possible of the start of each string:
Dim c = ""
If(a.Length > 50 AndAlso b.Length < 50)
c = a.Remove(100 - b.Length) & b
Else If a.Length > 50 AndAlso b.Length > 50
c= a.Remove(50) & b.Remove(50)
Else
c = a & b
End if
If c.Length > 100 Then c = c.Remove(100)
As with some other answers, the algorithm is open to interpretation. My method takes from each string until 100 total characters are taken or the string runs out of characters.
Private Function concat(a As String, b As String, length As Integer) As String
Dim ca As New System.Text.StringBuilder()
Dim cb As New System.Text.StringBuilder()
For i As Integer = 0 To length - 1
ca.Append(If(i >= a.Length, "", a(i)))
cb.Append(If(i >= b.Length, "", b(i)))
If ca.Length + cb.Length >= length Then Exit For
Next
Return (ca.ToString() & cb.ToString() & New String(" "c, 100)).Substring(0, length)
End Function
Sub Main()
Dim a As String = New String("a"c, 0)
Dim b As String = New String("b"c, 5)
Dim c As String = concat(a, b, 100)
Console.WriteLine($"'{c}'")
End Sub
'bbbbb '
(padded to 100 characters, doesn't render in block quote)
Dim a As String = New String("a"c, 30)
Dim b As String = New String("b"c, 90)
'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb'
Dim a As String = New String("a"c, 72)
Dim b As String = New String("b"c, 64)
'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb'
(your example in a comment. 72 >> 50, 64 >> 50)

VBA : For loop exiting without returning the value

I have the following piece for code to simulate stock prices using stochastic process
Function varswap1(s0, r0, sigma0, t) As Double
Rnd (-10)
Randomize (999)
Dim i As Integer, j As Integer, r As Double
Dim stock() As Double, dt As Double
Dim per As Integer
per = WorksheetFunction.Round(t * 252, 0)
ReDim stock(per)
stock(1) = s0
dt = 1 / 252
For i = 1 To per
stock(i + 1) = stock(i) * Exp((r0 - 0.5 * sigma0 ^ 2) * dt + sigma0 * Sqr(dt) * WorksheetFunction.NormSInv(Rnd()))
Next
varswap1 = WorksheetFunction.Average(stock)
End Function
In this code, I ran debugging by placing a break point at Next and the entire For loop is working absolutely fine. The problem is after completing the loop the function exits and #VALUE! error is displayed in the cell.
I am not able to figure out what is wrong with this code.
Will be thankful if anyone can help me with it.
Try this:
Const n As Integer = 252
Function varswap1(s0, r0, sigma0, t) As Double
Rnd (-10)
Randomize (999)
Dim i As Integer, j As Integer, r As Double
Dim stock() As Double, dt As Double
Dim per As Integer
per = WorksheetFunction.Round(t * n, 0)
ReDim stock(per)
stock(0) = s0 ' First item in the array has index 0
dt = 1# / n ' Avoid integer division, 1/252 = 0
For i = 1 To per
'Each stock depends on the previous stock value:
stock(i) = stock(i - 1) * Exp((r0 - 0.5 * sigma0 ^ 2) * dt + sigma0 * Sqr(dt) * WorksheetFunction.NormSInv(Rnd()))
Next
varswap1 = WorksheetFunction.Average(stock)
End Function
I saw two issues and one suggestion.
One is the array stock goes from 0..252 but you assign values to 1..253 so it crashes.
Also there is a possible integer division resulting in dt=0.0. I updated the definition to make the intent clear that the division is to be done after the conversion from integer to double. Lastly, I moved the magic number 252 to a constant.

Recursion code in VBA

I am trying to run this code to calculate Q(n) at different Tn in the Equation 16.4 in the attached picture.But its not giving me the correct output. I would appreciate any help. Note: delta1=delta2 =...deltan = dt=1 ( I have taken here ) and further divided S term by 10000 just because in the Equation it is in basis point i.e. 100th part of 1 %.
Function Bootstrap(S As Range, Z As Range, L As Double) As Double
Dim j As Integer
Dim a As Variant
Dim b As Variant
Dim n As Integer
Dim Q() As Double
Dim sum As Double
Dim P As Double
Dim dt As Double
n = Application.WorksheetFunction.Max(S.Columns.Count, Z.Columns.Count)
a = S.Value
b = Z.Value
dt = 1
sum = 0
ReDim Q(0 To n)
Q(0) = 1
For j = 1 To n - 1
P = (b(1, j) * (L * Q(j - 1) - (L + dt * a(1, n) / 10000) * Q(j))) / (b(1, n) * (L + a(1, n) * dt / 10000)) + Q(n - 1) * L / (L + a(1, n) * dt / 10000)
sum = sum + P
Q(n) = sum
Next j
Bootstrap = sum
End Function
To solve a recursive function you can write it this way, for example
Function Factorial(n as long) as long
If n = 1 Then
Factorial = 1
Else
Factorial = n * Factorial(n-1)
End If
End function
Yes, you can see For...Loop can also do the Factorial calculation, but in your case, its much easier to use recursive solution.
Besides Eq 16.4 is intentionally written as a recursive function. It is not written as a summation function because it is harder to do so. If given to you is a summation function, then you can apply the For...Loop solution.
Hope this helps.
EDIT
Function Q(n as long) as double
If n = 1 Then
Q = 5
Else
Q = Z * ( L * Q_t - (L + d * S) * Q(n-1) ) / ( Z * ( L + d * S ) )
End If
End Function
Notice that the function Q keep calling itself in Q(n-1) when n>1. That is called recursive solution.
(Check the formula. I might copy it wrong)

use a created function within a function vba

Im Making a VBA function to calculate an integral using the trapezoidal rule
but how can I apply a function that I created in VBA to Use in a another Function...heres My Code ( the worksheet.function did not work)
Option Explicit
Function funcion(x As Double) As Double
funcion = 3 * (x ^ 3) + 5 * (x ^ 2) - 10 * x + 20
End Function
Function Sumatoria(a As Double, n As Double, h As Double) As Double
Dim i As Integer
Dim sum As Double
i = 0
sum = 0
Do While (i <= n - 1)
sum = sum + WorksheetFunction.funcion(a + i * h)
i = i + 1
Loop
Sumatoria = sum
End Function
This works :
Function Sumatoria(a As Double, n As Double, h As Double) As Double
Dim i As Integer
Dim sum As Double
Dim temp As Double
i = 0
sum = 0
Do While (i <= n - 1)
temp = a + i * h
sum = sum + funcion(temp)
i = i + 1
Loop
Sumatoria = sum
End Function

Resources