I have a function that calcuates a BOL number and only take the first 10 digits.
Here's the code.
Public Function GENERATEBOLNUMBER(iYearSuffix As Integer, _
sFromZipcode As String, _
sToZipCode As String, _
iWeight As Integer, _
iShowID As Integer) As String
Application.ScreenUpdating = False
GENERATEBOLNUMBER = VBA.Left(7 & _
WorksheetFunction.RoundUp(VBA.Right(sFromZipcode, 5) _
* VBA.Right(sToZipCode, 5) * iWeight * (iShowID + 1234), 0), 10)
Application.ScreenUpdating = True
End Function
And here are the values I'm passing it. 7 for the iYearSuffix, 78224 for sFromZipcode and 78224 for sToZipCode, 410 as the iWeight, and 1 as the iShowID. All of this calculates to 3098352701017600, so the final string should be 7309835270, which is the 7 included as the first digit and the following 9 digits.
Where is the decimal coming from? The answer I'm getting is: 73.0983527.
You're mixing string handling, numeric manipulation, implicit casts between strings and numbers, VBA, WorksheetFunction, and gigantic numbers. What could possibly go wrong?
If you're going to write a UDF in VBA, write it in VBA. The only data type large enough to store your result is going to be a Decimal, so you'll have to declare it as a Variant and explicitly cast the calculation to force it to coerce:
Public Function GENERATEBOLNUMBER(yearSuffix As Integer, fromZip As String, _
toZip As String, weight As Integer, _
showId As Integer) As String
Dim result As Variant
'Calculate intermediary result.
result = CDec(Right$(fromZip, 5)) * CDec(Right$(toZip, 5)) * weight * (showId + 1234)
'Shift the decimal place 7 places to the left:
result = result / 10 ^ 7
'Skip the RoundUp call - it wasn't doing anything because your result was an integer.
'Strip the non-integer portion:
result = Fix(result)
'Cast to a string an concatenate the "7" onto the start:
GENERATEBOLNUMBER = "7" & CStr(result)
End Function
Related
My code has a problem with conversion of the number 3
I would like to write a function which converts a decimal number into a binary one. The principle of recursion must be used. I have already written the following code.
Function recursive(number As Integer) As String
Dim result As String
If number > 0 Then
Dim binaryNumber As String
Dim digit As Integer
binaryNumber = recursive(number / 2)
digit = number Mod 2
result = result & binaryNumber & digit
End If
recursive = result
End Function
Right result:
Input: 10
Output: 1010
Wrong result:
Input: 3
Output: 101
It also works reasonably well, but I get a wrong result when I try to convert the decimal number 3. Where is the error?
Function recursive(number As Integer) As String
Dim result As String
If number > 0 Then
Dim binaryNumber As String
Dim digit As Integer
digit = number Mod 2
number = Int(number / 2)
binaryNumber = recursive(number)
result = result & binaryNumber & digit
End If
recursive = result
End Function
When I send in the string 1111101110001110 as the binary form of the number that I want, I get an
Error Overflow
in the code. Which in decimal would be 64398. I am returning it to an integer in the main function. This number should be small enough as to not overflow the integer right? Any help would be greatly appreciated.
Function Bin2Dec(ByVal Binarystring As String) As Integer ' This converts a binary to a decimal
Dim X As Integer
For X = 0 To Len(Binarystring) - 1
Bin2Dec = CDec(Bin2Dec) + Val(Mid(Binarystring, _
Len(Binarystring) - X, 1)) * 2 ^ X
Next
End Function
I have the following input:
Dim str_format as string = "XXXXX00000"
Dim str as string = "INV"
Dim int as integer = "56"
How can I replace XXXXX with INV and replace 00000 with 56?
For the example above the result should be INVXX00056.
X can only replace with alphabet and 0 can only replace with integer, if str has more than five alphabet. The extra alphabets will be thrown away because str_format only has five X. The same algorithm is true for the integer.
Example 2
Dim str_format as string = "XXX00000"
Dim str as string = "ABCD"
Dim int as integer = 654321
Expected result: ABC54321
Process:
1. ABCD XXX00000 654321
2. ABC DXX000006 54321
3. AB CDX00065 4321
4. A BCD00654 321
5. ABC06543 21
6. ABC65432 1
7. ABC54321
As Spidey mentioned... show some code. That said the process you describe is a bit long-winded.
The Letter part of the solution can be done by grabbing the first 3 characters of str using Left(str,3) this will bring in the leftmost 3 character (if there are less it will get what is there). Then check that you have 3 characters using str.Length(). If the length is less than 3 then append the appropriate number of 'X'.
The Numeric part can be done in a similar way. Your int is actually a string in your code above. If it was a real integer you can cast it to string. Use Right(int,5). Again check to see you have 5 digits and if not prepend with appropriate number of 0.
Have a go... if you run into problems post your code and someone is bound to help.
UPDATE
As there have been actual answers posted here is my solution
Function FormatMyString(str As String, num as String) As String
Dim result As String
result = Left(str,3).PadRight(3, "X"c).ToUpper() & Right(num,5).PadLeft(5, "0"c)
Return result
End Function
UPDATE 2
based on Wiktors answer... made an amendment to my solution to cope with different formats
Function FormatMyString(str As String, num as String, alpha as Integer, digits as Integer) As String
Dim result As String
result = Left(str, alpha).PadRight(alpha, "X"c).ToUpper() & Right(num, digits).PadLeft(digits, "0"c)
Return result
End Function
To use...
FormatMyString("ABCDE", "56",3 5) will return ABC00056
FormatMyString("ABCDE", "123456",4 3) will return ABCD456
FormatMyString("AB", "123456",4 3) will return ABXX456
Here is a possible solution that just uses basic string methods and PadLeft/PadRight and a specific method to count occurrences of specific chars in the string. It assumes the format string can only contain X and 0 in the known order.
Public Function CountCharacter(ByVal value As String, ByVal ch As Char) As Integer
Return value.Count(Function(c As Char) c = ch)
End Function
Public Sub run1()
Dim str_format As String = "XXXXX00000" '"XXX00000"
Dim str As String = "INV"
Dim int As Integer = 56 ' ABC54321
Dim xCnt As Integer = CountCharacter(str_format, "X")
Dim zCnt As Integer = CountCharacter(str_format, "0")
Dim result As String
If xCnt > str.Length Then
result = str.PadRight(xCnt, "X")
Else
result = str.Substring(0, xCnt)
End If
If zCnt > int.ToString().Length Then
result = result & int.ToString().PadLeft(zCnt, "0")
Else
result = result & int.ToString().Substring(int.ToString().Length-zCnt
End If
Console.WriteLine(result)
End Sub
Output for your both scenarios is as expected.
Take a look at this sample
Dim str_format As String = str_format.Replace("XXX", "ABC")
Msgbox(str_format )
As we assume that the X is 3 only. I dont want to give you more it is a start and everything will be easy.
If that kind of format is fix I mean the number of X will go or down then you can make a conditional statement based on the length of string
So I'm calculating basic statistics in my worksheet and it includes code such as:
xxx = Application.worksheetfunction.average(etc etc etc
yyy = Application.worksheetfunction.min(etc etc etc
zzz = Application.worksheetfunction.max(etc etc etc
My question: Is there an RMS equivalent function where I can simply plug it in place of where I have 'average, min, max' functions in that code? And if there isn't then what would be the most efficient means to code in to find RMS solutions?
I hope I've stated the goal clearly enough. I'm curious as to whether or not there is a predefined RMS function for VBA or whether or not I've got to create some sort of user defined function? ~ That of which I'm fairly new to as well so if there isn't a simple line of code to write for this, I'll have to do more reading on UDF's.
EDIT:
I've got around 30,000 rows, and for simplicity's sake: imagine two columns. Column A has the year i.e. 1941 or anything else through 2008. Column B is a numeric value. I'm just trying to put code together that gives decade summaries of Average, Min, Max, and the RMS values.
You can do the average with
=SQRT(SUMSQ(A:A)/COUNTA(range))
or in VBA:
r = (Application.WorksheetFunction.SumSq(Range("A:A")) / Range("A:A").Count) ^ (1 / 2)
A VBA function that accepts arrays (any rank) and ranges with multiple areas (a discontinuous range like A4:B6,C11:D15), or even a union of ranges in a formula. It skips non number datatypes (including dates, boolean, blanks etc).
You can use it in VBA code, or as a UDF in a worksheet formula such as:
"=RMS(A1:A10)" (basic usage)
"=RMS(A1:A10,C1:C10)" (multiple ranges (or arrays for that matter))
"{=RMS({1,2,3,4})}" (array formula entered with Ctrl+shift+enter)
Function RMS(ParamArray args()) As Double
Dim arg, arr, area As Range, ss As Double, n As Long
For Each arg In args
If TypeOf arg Is Range Then
For Each area In arg.Areas
arr = area.value
If VarType(arr) < vbArray Then
queryRmsElements Array(arr), ss, n
Else
queryRmsElements arr, ss, n
End If
Next area
ElseIf VarType(arg) > vbArray Then
queryRmsElements arg, ss, n
Else
Err.Raise 1, "RMS", "Invalid Argument"
End If
Next arg
RMS = (ss / n) ^ 0.5
End Function
Private Sub queryRmsElements(ByRef elements, ByRef ss As Double, ByRef n As Long)
Static element As Variant
'Enumerate to cover rank > 1 (vs. Iterate)
For Each element In elements
Select Case VarType(element)
Case VbVarType.vbByte, _
VbVarType.vbCurrency, _
VbVarType.vbDecimal, _
VbVarType.vbDouble, _
VbVarType.vbInteger, _
VbVarType.vbLong, _
VbVarType.vbSingle
ss = element ^ 2 + ss
n = n + 1
Case Else
End Select
Next element
End Sub
This one worked for me:
Function RMS(Intervalo As Range)
Dim SomaQ As Double
Dim Tamanho As Integer
SomaQ = 0
Tamanho = Intervalo.Count
SomaQ = Application.WorksheetFunction.SumSq(Intervalo)
RMS = Sqr(SomaQ / Tamanho)
End Function
I need to truncate the amount of decimal places of my double value for display in a textbox. How would one achieve this with vba?
If you want to round the value, then you can use the Round function (but be aware that VBA's Round function uses Banker's rounding, also known as round-to-even, where it will round a 5 up or down; to round using traditional rounding, use Format).
If you want to truncate the value without rounding, then there's no need to use strings as in the accepted answer - just use math:
Dim lDecimalPlaces As Long: lDecimalPlaces = 2
Dim dblValue As Double: dblValue = 2.345
Dim lScale = 10 ^ lDecimalPlaces
Dim dblTruncated As Double: dblTruncated = Fix(dblValue * lScale) / lScale
This yields "2.34".
You can either use ROUND for FORMAT in VBA
For example to show 2 decimal places
Dval = 1.56789
Debug.Print Round(dVal,2)
Debug.Print Format(dVal,"0.00")
Note: The above will give you 1.57. So if you are looking for 1.56 then you can store the Dval in a string and then do this
Dim strVal As String
dVal = 1.56789
strVal = dVal
If InStr(1, strVal, ".") Then
Debug.Print Split(strVal, ".")(0) & "." & Left(Split(strVal, ".")(1), 2)
Else
Debug.Print dVal
End If
You can use Int() function. Debug.print Int(1.99543)
Or Better:
Public Function Trunc(ByVal value As Double, ByVal num As Integer) As Double
Trunc = Int(value * (10 ^ num)) / (10 ^ num)
End Function
So you can use Trunc(1.99543, 4) ==> result: 1.9954
This was my attempt:
Function TruncateNumber(decimalNum As Double, decPlaces As Integer) As Double
'decimalNum: the input number to be truncated
'decPlaces: how many decimal places to round to. Use 0 for no decimal places.
decimalLocation = InStr(decimalNum, ".")
TruncateNumber = Left(decimalNum, decimalLocation + decPlaces)
End Function
It uses strings to avoid any math errors caused by different rounding methods. It will output as a type double, so you can still perform your own math on it.
This will cause an error if a number without a decimal place is passed into the above function. If this is a concern, you can use the following code instead:
Function TruncateNumber(decimalNum As Double, decPlaces As Integer) As Double
'decimalNum: the input number to be truncated
'decPlaces: how many decimal places to round to. Use 0 for no decimal places.
If InStr(decimalNum, ".") = 0 Then 'if there was no decimal:
'then return the number that was given
TruncateNumber = decimalNum
Else 'if there is a decimal:
'then return the truncated value as a type double
decimalLocation = InStr(decimalNum, ".")
TruncateNumber = Left(decimalNum, decimalLocation + decPlaces)
End If
End Function
Hopefully these functions are of some use to someone. I haven't done extensive testing, but they worked for me.
EDITED
Newer version of Excel (VBA) have a TRUNC function which already does things properly.
For older versions of EXCEL
I wanted to truncate a double into an integer.
value = Int(83.768)
value == 83
Awesome, it worked.
Depending on your version of Excel (VB) this might not work with negative numbers.
value = Int(-83.768)
value == -84
VB uses Banker rounding.
Public Function Trunc1(ByVal value As Double) As Integer
' Truncate by calling Int on the Absolute value then multiply by the sign of the value.
' Int cannot truncate doubles that are negative
Trunc1 = Sgn(value) * Int(Abs(value))
End Function
If you want specific decimal places do what Makah did only with Abs around the value so Int can truncate properly.
Public Function Trunc2(ByVal value As Double, Optional ByVal num As Integer = 1) As Double
' Truncate by calling Int on the Absolute value then multiply by the sign of the value.
' Int cannot truncate doubles that are negative
Trunc2 = Sgn(value) * (Int(Abs(value) * (10 ^ num)) / (10 ^ num))
End Function
Here is a little experiment I did... (1st time posting and answer, please tell me if I am not following conventions.
Sub Truncate()
Dim dblNum As Double
Dim intDecimal As Integer
dblNum = 1578.56789
intDecimal = 2 '0 returns 1578
'2 returns 1578.56
'-2 returns 1500
Debug.Print (Int(dblNum * 10 ^ intDecimal) / 10 ^ intDecimal)
End Sub