I am writing a code where one of the lines( Range("H5").value = 10 ) should assign a specific value to a specific cell. However it gives me an #VALUE! error on my cell. Here is my code please help!!:
Function TotalAdUnits(Money As Currency, CycleEarning As Integer) As Integer
TapCost = 16
TotalAdUnits = 0
AdUnit = 0
i = 1
Money = Money + CycleEarning
Do While (Money >= TapCost)
Money = Money - TapCost
TotalAdUnits = TotalAdUnits + Range("L1").Offset(i, 0)
TapCost = Range("J2").Offset(i, 0)
Range("H5").value = 10
i = i + 1
Loop
End Function
You cannot set a cells value from a UDF - a function used in this way can only return a value to the calling cell (or range, if it's used as an array function). Edit your function to return the value, instead of trying to set it directly.
Having said that, I'm not clear on exactly what you're trying to do with that function. Why set the same value in a loop?
Also, if you reference ranges directly from your function, and those ranges are not passed as parameters, you need to include
Application.Volatile
in your function so Excel knows to recalculate it any time the sheet changes.
Function TotalAdUnits(Money As Currency, CycleEarning As Integer) As Integer
TapCost = 16
TotalAdUnits = 0
AdUnit = 0
i = 1
Money = Money + CycleEarning
Do While (Money >= TapCost)
Money = Money - TapCost
TotalAdUnits = TotalAdUnits + Range("L1").Offset(i, 0)
TapCost = Range("J2").Offset(i, 0)
Range("H5").value = 10
i = i + 1
Loop
'need to return a value...
TotalAdUnits = 10 '?
End Function
Related
Typically the accepted approach is to do the following
Number to Letter
public function numberToLetter(ByVal i as long) as string
Dim s as string: s = cells(1,i).address(false,false)
numberToLetter = left(s,len(s)-1)
end function
Letter to Number
Public Function letterToNumber(ByVal s As String) As Long
letterToNumber = Range(s & 1).Column
End Function
However neither of these are particular optimal, as in each case we are creating an object, and then calling a property accessor on the object. Is there a faster approach?
Summary
The core thing to realise is that the lettering system used in Excel is also known as Base26. NumberToLetter is encoding to Base26 from decimal, and LetterToNumber is decoding from Base26 to decimal.
Base conversion can be done with simple loops and
Function base26Encode(ByVal iDecimal As Long) As String
if iDecimal <= 0 then Call Err.Raise(5, "base26Encode" ,"Argument cannot be less than 0")
if iDecimal >= 16384 then Call Err.Raise(5, "base26Encode" ,"There are only 16384 columns in a spreadsheet, thus this function is limited to this number.")
Dim s As String: s = ""
Do
Dim v As Long
v = (iDecimal - 1) Mod 26 + 1
iDecimal = (iDecimal - v) / 26
s = Chr(v + 64) & s
Loop Until iDecimal = 0
base26Encode = s
End Function
Function base26Decode(ByVal sBase26 As String) As Long
sBase26 = UCase(sBase26)
Dim sum As Long: sum = 0
Dim iRefLen As Long: iRefLen = Len(sBase26)
For i = iRefLen To 1 Step -1
sum = sum + (Asc((Mid(sBase26, i))) - 64) * 26 ^ (iRefLen - i)
Next
base26Decode = sum
End Function
Performance
I tested the performance of these functions against the original functions. To do this I used the stdPerformance class of stdVBA.
The code used for testing is as follows:
Sub testPerf()
Dim cMax As Long: cMax = 16384
With stdPerformance.Measure("Encode Original")
For i = 1 To cMax
Call numberToLetter(i)
Next
End With
With stdPerformance.Measure("Encode Optimal")
For i = 1 To cMax
Call base26Encode(i)
Next
End With
With stdPerformance.Measure("Decode Original")
For i = 1 To cMax
Call letterToNumber(base26Encode(i))
Next
End With
With stdPerformance.Measure("Decode Optimal")
For i = 1 To cMax
Call base26Decode(base26Encode(i))
Next
End With
End Sub
The results for which are as follows:
Encode Original: 78 ms
Encode Optimal: 31 ms
Decode Original: 172 ms
Decode Optimal: 63 ms
As shown this is a slightly faster approach (2-3x faster). I am fairly surprised that object creation and property access performed so well however.
I need to remove the numeric part at the end of a string. Here are some examples:
"abcd1234" -> "abcd"
"a3bc45" -> "a3bc"
"kj3ih5" -> "kj3ih"
You get the idea.
I implemented a function which works well for this purpose.
Function VarStamm(name As String) As String
Dim i, a As Integer
a = 0
For i = Len(name) To 1 Step -1
If IsNumeric(Mid(name, i, 1)) = False Then
i = i + 1
Exit For
End If
Next i
If i <= Len(name) Then
VarStamm = name.Substring(0, i - 1)
Else
VarStamm = name
End If
End Function
The question is: is there any faster (more efficient in speed) way to do this? The problem is, I call this function within a loop with 3 million iterations and it would be nice to have it be more efficient.
I know about the String.LastIndexOf method, but I don't know how to use it when I need the index of the last connected number within a string.
You can use Array.FindLastIndex and then Substring:
Dim lastNonDigitIndex = Array.FindLastIndex(text.ToCharArray(), Function(c) Not char.IsDigit(c))
If lastNonDigitIndex >= 0
lastNonDigitIndex += 1
Dim part1 = text.Substring(0, lastNonDigitIndex)
Dim part2 = text.Substring(lastNonDigitIndex)
End If
I was skeptical that the Array.FindLastIndex method was actually faster, so I tested it myself. I borrowed the testing code posted by Amessihel, but added a third method:
Function VarStamm3(name As String) As String
Dim i As Integer
For i = name.Length - 1 To 0 Step -1
If Not Char.IsDigit(name(i)) Then
Exit For
End If
Next i
Return name.Substring(0, i + 1)
End Function
It uses your original algorithm, but just swaps out the old VB6-style string methods for newer .NET equivalent ones. Here's the results on my machine:
RunTime :
- VarStamm : 00:00:07.92
- VarStamm2 : 00:00:00.60
- VarStamm3 : 00:00:00.23
As you can see, your original algorithm was already quite well tuned. The problem wasn't the loop. The problem was Mid, IsNumeric, and Len. Since Tim's method didn't use those, it was much faster. But, if you stick with a manual for loop, it's twice as fast as using Array.FindLastIndex, all things being equal
Given your function VarStamm and Tim Schmelter's one named VarStamm2, here is a small test performance I wrote. I typed an arbitrary long String with a huge right part, and ran the functions one million times.
Module StackOverlow
Sub Main()
Dim testStr = "azekzoerjezoriezltjreoitueriou7657678678797897898997897978897898797989797"
Console.WriteLine("RunTime :" + vbNewLine +
" - VarStamm : " + getTimeSpent(AddressOf VarStamm, testStr) + vbNewLine +
" - VarStamm2 : " + getTimeSpent(AddressOf VarStamm2, testStr))
End Sub
Function getTimeSpent(f As Action(Of String), str As String) As String
Dim sw As Stopwatch = New Stopwatch()
Dim ts As TimeSpan
sw.Start()
For i = 1 To 1000000
f(str)
Next
sw.Stop()
ts = sw.Elapsed
Return String.Format("{0:00}:{1:00}:{2:00}.{3:00}",
ts.Hours, ts.Minutes, ts.Seconds,
ts.Milliseconds / 10)
End Function
Function VarStamm(name As String) As String
Dim i, a As Integer
a = 0
For i = Len(name) To 1 Step -1
If IsNumeric(Mid(name, i, 1)) = False Then
i = i + 1
Exit For
End If
Next i
If i <= Len(name) Then
VarStamm = name.Substring(0, i - 1)
Else
VarStamm = name
End If
End Function
Function VarStamm2(name As String) As String
Dim lastNonDigitIndex = Array.FindLastIndex(name.ToCharArray(), Function(c) Not Char.IsDigit(c))
If lastNonDigitIndex >= 0 Then
lastNonDigitIndex += 1
Return name.Substring(0, lastNonDigitIndex)
End If
Return name
End Function
End Module
Here is the output I got:
RunTime :
- VarStamm : 00:00:38.33
- VarStamm2 : 00:00:02.72
So yes, you should choose his answer, his code is both pretty and efficient.
I am a just beginning to learn VBA. I am trying to do a loop that will act as a solver to find the number of payments for a loan:
Function FonctionValue(rate As Double, pmt1 As Double, loan As Double, nbpmt As Double)
FonctionValue = Application.WorksheetFunction.pmt(rate, nbpmt, loan) - pmt1
End Function
Function Npmt(nbpmtlow As Double, nbpmthigh As Double, rate As Double, loan As Double, pmt1 As Double) As Variant
Dim i As Integer
Dim nbpmt As Double
For i = 1 To 100
flow = FonctionValue(rate, pmt1, loan, nbpmtlow)
fhigh = FonctionValue(rate, pmt1, loan, nbpmthigh)
value = nbpmtlow - flow * (nbpmthigh - nbpmtlow) / (fhigh - flow)
fnbpmt = FonctionValue(rate, pmt1, loan, nbpmt)
If fhigh * fnbpmt > 0 Then
nbpmthigh = value
Else
nbpmtlow = value
End If
Next i
value = Npmt
End Function
The main issues:
In the line fnbpmt = FonctionValue(rate, pmt1, loan, nbpmt), nbmpt = 0. This is an invalid input to WorksheetFunction.Pmt. It's not immediately clear what nbpmt should be, but it must be greater than 0.
Change value = Npmt to Npmt = Value; you have the order backwards.
As part of a larger script, I am trying to replace fraction values with decimal values in excel using vbscript. I can always count on the values to have a specific column and a specific format.
Excel example expected input column B:
51-7/16
1-1/2
2
15-7/8
Excel example desired output column B:
51.4375
1.5
2
15.875
I know it will always be to a 1/16th. So my idea was to go through the list looking for each possible fraction, find a cell that contains that fraction, and replace it with the corresponding decimal.
Questions: How do I tell the script to find a cell that contains a value and how do I replace that fraction with the decimal?
closest example Search and Replace a number of characters in Excel using VBscript
Attempt:
Dim FMember (14)
FMember(0) = "-1/16"
FMember(1) = "-1/8"
FMember(2) = "-3/16"
FMember(3) = "-1/4"
FMember(4) = "-5/16"
FMember(5) = "-3/8"
FMember(6) = "-7/16"
FMember(7) = "-1/2"
FMember(8) = "-9/16"
FMember(9) = "-5/8"
FMember(10) = "-11/16"
FMember(11) = "-3/4"
FMember(12) = "-13/16"
FMember(13) = "-7/8"
FMember(14) = "-15/16"
Dim DMember(14)
DMember(0) = ".0625"
DMember(1) = ".125"
DMember(2) = ".1875"
DMember(3) = ".25"
DMember(4) = ".3125"
DMember(5) = ".375"
DMember(6) = ".4375"
DMember(7) = ".5"
DMember(8) = ".5625"
DMember(9) = ".625"
DMember(10) = ".6875"
DMember(11) = ".75"
DMember(12) = ".8125"
DMember(13) = ".875"
DMember(14) = ".9375"
Dim endRow2
endRow2 = objSheet2.UsedRange.Rows.Count
For lngPosition = LBound(FMember) To UBound(FMember)
For r = 1 To endRow2
If objSheet2.Cells(r, objSheet2.Columns("B").Column).Value = FMember(lngPosition) Then
objSheet2.replace
End If
Next
Next
Use split()
Function fract(str As String) As Double
Dim strArr() As String
If InStr(str, "-") Then
strArr = Split(str, "-")
fract = strArr(0) + Application.Evaluate(strArr(1))
Else
fract = Application.Evaluate(str)
End If
End Function
Then you can use it as a worksheet function:
=fract(A1)
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