I am very new to VBA. I am sorry if my question is very easy. I have a question. When I run the following code, I get the following error message:
Compiler Error: Ambiguous Name Detected: faren
Can anyone please explain what part of my code is wrong?
Option Explicit
Dim n As Double
Private faren As Integer
Dim result As Double
Function faren(n)
faren = (9 / 5) * (n + 32)
End Function
Function c(n)
Dim c As Long
c = (5 / 9) * (n - 32)
End Function
Sub test()
result = faren(32)
MsgBox "the degree in farenheit is " & result & "Farenheit."
End Sub
You declare faren two times. First one Private faren As Integer and second one Function faren(n)
To avoid ambiguous names you can delete Private faren As Integer and amend the function line like this: Function faren(n) As Integer
Edit: I don't know if you declare faren intentionally as Integer instead of Double, but I want you to see the following results to compare the difference:
When Function faren(n) As Integer is used n = 32 --> result = 115
When Function faren(n) As Double is used n = 32 --> result = 115.2
You might want to consider declaring c as double in the same way because it affects the result as well.
Related
I have a 32-bit value that is stored in the VB.Net type Integer (i.e. Int32.) I am only interested in the bits - not the numerical value. Sometimes the 32nd bit is a one which is interpreted as a negative number. My goal is to reverse the actual bits. My original data is encoded into bits right-to-left (LSB right-most) and is read back in left-to-right (MSB left-most.) I am adapting someone else's code and design. One thought I had was maybe to convert to a long temporarily but I don't know how to do that and preserve the 32nd bit correctly.
Public Shared Function ReverseBits32(ByVal n As Integer) As Integer
Dim result As Integer = 0
For i As Integer = 0 To 32 - 1
result = result * 2 + n Mod 2
n = n >> 1 'n Or 2
Next
Return result
End Function
If you had a method to reverse the bits of a byte you could apply it four times to the bytes of an integer. A little research finds Bit Twiddling Hacks.
Module Module1
Sub ShowBits(a As Integer)
Dim aa = BitConverter.GetBytes(a)
Console.WriteLine(String.Join(" ", aa.Select(Function(b) Convert.ToString(b, 2).PadLeft(8, "0"c))))
End Sub
Function ReverseBits(b As Byte) As Byte
' From https://graphics.stanford.edu/~seander/bithacks.html#ReverseByteWith32Bits
Dim c = CULng(b)
Return CByte((((c * &H802UL And &H22110UL) Or (c * &H8020UL And &H88440UL)) * &H10101UL >> 16) And &HFFUL)
End Function
Function ReverseBits(a As Integer) As Integer
Dim bb = BitConverter.GetBytes(a)
Dim cc(3) As Byte
For i = 0 To 3
cc(3 - i) = ReverseBits(bb(i))
Next
Return BitConverter.ToInt32(cc, 0)
End Function
Sub Main()
Dim y = -762334566
ShowBits(y)
y = ReverseBits(y)
ShowBits(y)
Console.ReadLine()
End Sub
End Module
Output from test value:
10011010 10110010 10001111 11010010
01001011 11110001 01001101 01011001
I used the "no 64-bit" method because it is written for a language where arithmetic overflow is ignored - the methods using 64-bit operations rely on that but it is not the default for VB.NET.
I am really a freshman to study the VBA. I am confused about how to add an error message in a function subroutines.
Here is my problem, when I finished identify a function, how can I add an error message like this: "Please enter the value in an increasing order"?
e.g: If I type =triangular(3,2,1), where the number is in a decreasing order, I should get an error message.
Here is my code:
Public Function triangular(Minimum As Single, mostlikelyvalue As Single, maximum As Single) As Single
Dim uniform As Single
Dim d As Single
Randomize
Application.Volatile
d = (mostlikelyvalue - Minimum) / (maximum - Minimum)
uniform = Rnd
If uniform <= d Then
triangular = Minimum + (maximum - Minimum) * Sqr(d * uniform)
Else
triangular = Minimum + (maximum - Minimum) * (1 - Sqr((1 - d) * (1 - uniform)))
End If
End Function
You can test for incorrect order, or also an invalid entry directly in your function and return that rather than use error handling
Changed variable names to help avoid errors and confusion with existing function
Use a variant function to hold either the result or one of the two customised error messages
You may as well use Doubles rather than Singles
code
Public Function triangular(dbMinimum As Double, dbMostlikelyvalue As Double, dbMaximum As Double)
Dim uniform As Double
Dim d As Double
Dim dbCnt As Double
dbCnt = dbMinimum * dbMostlikelyvalue * dbMaximum
If dbCnt = 0 Then
triangular = "at least one value is zero"
Exit Function
End If
If dbMostlikelyvalue > dbMaximum Or dbMinimum > dbMostlikelyvalue Then
triangular = "values not sorted"
Exit Function
End If
Randomize
Application.Volatile
d = (dbMostlikelyvalue - dbMinimum) / (dbMaximum - dbMinimum)
uniform = Rnd
If uniform <= d Then
triangular = dbMinimum + (dbMaximum - dbMinimum) * Sqr(d * uniform)
Else
triangular = dbMinimum + (dbMaximum - dbMinimum) * (1 - Sqr((1 - d) * (1 - uniform)))
End If
End Function
Try this
Public Sub Sample
On Error Goto Err
'call your function here
'some more codes here
Exit Sub 'if all goes well code ends here
Err: 'Error handler
MsgBox Err.Description
End Sub
I am trying to check whether a given number is cuberoot or not in VBA.
The following code works only for 2 and 3 as answers, it does not work after that.
I am trying to figure out what is wrong in the code.
Sub cuberoot()
Dim n As Long, p As Long, x As Long, y As Long
x = InputBox("x= ")
If Iscube(x) Then
MsgBox ("Is cube")
Else
MsgBox ("No cube")
End If
End Sub
Private Function Iscube(a As Long) As Boolean
b = a ^ (1 / 3)
If b = Int(b) Then
Iscube = True
Else
Iscube = False
End If
End Function
Since you are passing in a Long I'll assume that you won't have a number bigger than roughly 2*10^9 so this should always work. It's a slight variation where you truncate the double and then compare to the two nearest integers to make sure you catch any rounding errors.
Edit: In VBA the truncating would always round so it's only neccessary to check the 3rd root value:
Public Function Iscube(a As Long) As Boolean
Dim b As Integer
b = CInt(a ^ (1# / 3#))
If (b ^ 3 = a) Then
Iscube = True
Else
Iscube = False
End If
End Function
If you need a number larger than a Long you'll need to change your input type and you might want to consider an iterative method like a binary search or a Newton-Raphson solver instead.
Existing Code
Your code will work if you add a
dim b as long
If you debug your code you will see that feeding in 125 gives you
b = 5
Int(b) = 4
Updated Code
You can shorten your boolean test to this
Function Iscube(lngIn As Long) As Boolean
Iscube = (Val(lngIn ^ (1 / 3)) = Int(Val(lngIn ^ (1 / 3))))
End Function
Note that if you call it with a double, it will opearte on the long portion only (so it would see IsCube(64.01)as IsCube(64))
This requires a solution & the code to migrate to Access from VB6 is below.
I have a function to compare characters that comes from VB6 and I am a novice user on VB6 and mostly work from VBA platform. I need to setup a class or a better way in MS Access to check character by character for typo mistakes without the use of UDT.
Mytypolist as an array refers to the following dataset:
QWA WESAQ ERDSW RTFDE TYGFR YUHGT UIJHY IOKJU OPLKI PLO AQWSZ SEDXZA DRFCXSE FTGVCDR GYHBVFT HUJNBGY JIKMNHU KOLMJI LPKO ZASX XZSDC CXDFV VCFGB BVGHN NBHJM MNJK
The above data is used to compare if a character was mistyped in a word.. ex. if I use A as in Auebec instead of what I mean to type Quebec, my cluster of interest is QWA; WESAQ; AQWSZ; or any other Q arrangement on a standard English Qwerty keyboard based on proximity. And this is not just for Q, but for entire set of alphabets, regardless of case, so c has its own cluster of possible typo matches etc..
In VB6 setup of UDT (user defined type):
'declare UDT type for typos
Public Type Mytypos
Rightrkey As String * 1
PossibleKey As String * 8
End Type
'declare arrays and variable for master list and typos
Public Masterlist() As String
Public Mytypolist(26) As Mytypos
Public Matchkey As Mytypos
the following function compares two words; and assign similarity by calculating currentpct score:
Public Function CompareCharacters(ByRef MasterWord As String, _
ByRef Checkword As String, ByRef CurrentPCT As Double, _
ByRef WordVal As Long) As Double
'define function variables
Dim ChrCount As Long
Dim ChrValue As Long
Dim loop1 As Long
Dim loop2 As Long
'define the letter values
If Len(MasterWord) > Len(Checkword) Then
ChrCount = Len(MasterWord) * 2
Else
ChrCount = Len(Checkword) * 2
End If
ChrValue = 1 / ChrCount
'say CURRENT PCT has a value of 10%
'check each letter for a match in current word position
For loop1 = 1 To Len(Checkword)
'check for typo errors (key proximity)
For loop2 = 0 To UBound(Mytypolist)
Matchkey = Mytypolist(loop2)
'if indexkey = letter in masterword
If Matchkey.Rightrkey = Mid(MasterWord, loop1, 1) Then
'does the letter in the checkword exist in the proximity keylist
If InStr(1, Matchkey.PossibleKey, Mid(Checkword, loop1, 1), vbTextCompare) > 0 Then
'value for letter found in proximity keylist
CurrentPCT = CurrentPCT + ChrValue
End If
Exit For
End If
Next loop2
Next loop1
CompareCharacters = CurrentPCT
End Function
IF you can post me a array/class solution that may not produce compiler issues (String UDT in VBA are a problem). Please check it out now!
It would probably best, since you have a 1 character to 8 character thing, to just have a full mapping. Something to replace this:
Public Type Mytypos
Rightrkey As String * 1
PossibleKey As String * 8
End Type
To:
PossibleKeys(255) As String * 8
That way, each character (from 0 to 255) would have the 8 character mapping. No UDT required!
I'm trying to make a slot machine program. This procedure that I'm trying to do will assign a name to 3 randomly generated numbers. For some reason I'm getting a conversion error saying that it cant convert the integer to a string. I tried cstr() as well but the problem persisted
Sub GenerateNumbers()
Dim numbers(2) As Integer
Dim names(5) As String
Dim x As Integer
names(0) = "Cherries"
names(1) = "Oranges"
names(2) = "Plums"
names(3) = "Bells"
names(4) = "Melons"
names(5) = "Bar"
For x = 0 To 2
numbers(x) = names(CInt(Int((6 * Rnd()) + 1)))
Next x
End Sub
gives me error: conversion from string "Oranges" to type 'Integer' is not valid
The problem is that you are getting a random string from the names array and trying to assign it to numbers, which is declared as an array of integers. Of course this is not gonna work.
Apart from that, there is also the issue with out of bounds index as Eric pointed out.
Edit in response to comments:
To get the text values of those randomly generated slot machine results you just need to declare the array to store results as strings, same way as names is declared.
To be able to get the results from a separate procedure, you need to change it from Sub to Function, which is a procedure that can return a value, an array of strings in this case. Then you can call this function from your Main or any other procedure and store the returned value in a variable.
I also corrected the part with random result generation.
Module SlotMachine
Sub Main()
Dim slotResults As String()
'Get the results
slotResults = GenerateResults()
'Some further processing of results here, e.g. print results to console
For Each item In slotResults
Console.WriteLine(item)
Next
'Wait for keypress before closing the console window
Console.ReadLine()
End Sub
'Generates random results
Function GenerateResults() As String()
Dim results(2) As String
Dim names(5) As String
Dim x As Integer
names(0) = "Cherries"
names(1) = "Oranges"
names(2) = "Plums"
names(3) = "Bells"
names(4) = "Melons"
names(5) = "Bar"
Randomize()
For x = 0 To 2
results(x) = names(Int(6 * Rnd()))
Next x
Return results
End Function
End Module
Int(6 * Rnd()) will get you 0-5, if you +1, then overflow