Declare multiple variables with zero in one line - vba

In an old macro I declare many variables in one line like
Dim Jan_Bnm, Feb_Bnm, Mar_Bnm, Apr_Bnm, Mai_Bnm, Jun_Bnm, Jul_Bnm, Aug_Bnm, Sep_Bnm, Okt_Bnm, Nov_Bnm, Dez_Bnm
With this variables I make some calculations like
Jan_Bnm = Jan_Bnm + 1
'e.g. empty = empty + 1 -> 1
Now I have the problem if the macro runs twice the old value is still stored
Jan_Bnm = Jan_Bnm + 1
'1 = 1 + 1 -> 2
So all my values are doubled.
Is it possible to set all variables by declaration to zero so that I don't have to set every (some hundreds) variable manualy?

Your current situation is the following:
Dim a As Long, b As Long, c As Long
Sub proc1()
End Sub
Sub proc2()
End Sub
The first way to avoid a, b and c still have a value when running proc1() the second time is to re-initialize them on proc1():
Sub proc1()
a = 0
b = 0
c = 0
'rest of the code
End Sub
Another way, you could pass the variables as parameters and declare them only on proc1():
Sub proc1()
Dim a As Long, b As Long, c As Long
'rest of the code
proc2 a,b,c
End Sub
Sub proc2(ByVal a As Long, ByVal b As Long, ByVal c As Long)
End Sub
Or, finally, you might think about working with a collection rather than with N variables. Example:
Dim myVars As New Collection
myVars.Add a
myVars.Add b
myVars.Add c
So now you will be able to reinitialize the variables as follows:
For j = 1 To myVars.Count
myVars(j) = 0
Next j
And what I said for the N variables (public declaration or private declaration + re-initialization) is applicable to the collection as well, but only once instead of N times (that's why I think it would simplify).

Related

I need to rewrite this from a sub into a function

This is the program I need to re-write and I dont understand.
Sub Main()
Dim array(24) As Double, i As Long
array(0) = 1
For i = 1 To 24
array(i) = 2 * array(i - 1)
Next i
Call DisplayArray(array)
End Sub
Sub DisplayArray(ByVal array() As Double)
Dim i As Long, n As Long
n = array.GetLength(0)
For i = 0 To n - 1
Console.WriteLine(array(i))
Next i
End Sub
I need it to
be a function
with two parameters, an array and constant k
should return an array where each elemtn of the array is equal to k ^ i
Well I can't really say I completely understand what you're doing. And I suspect this might be a homework question I'm giving the answers too against my better judgement. It's really not that complicated and likely something you could of done yourself with the appropriate research.
And calling a function for this does seem complete overkill as can be done quite simply when outputting your array in the DisplayArray method
Sub Main()
Dim array(24) As Double, i As Long
array(0) = 1
For i = 1 To 24
array(i) = 2 * array(i - 1)
Next i
'Calling the function here with the constant 3
Dim results() As Double = CalculateResults(array, 3)
Call DisplayArray(array)
Call DisplayArray(results)
Console.ReadLine()
End Sub
Sub DisplayArray(ByVal array() As Double)
Dim i As Long, n As Long
n = array.GetLength(0)
For i = 0 To n - 1
Console.WriteLine(array(i))
Next i
End Sub
Function CalculateResults(ByVal array As Double(), ByVal k As Integer) As Double()
Dim retVal(array.Length) As Double
For index = 0 To array.Length
retVal(index) = index ^ k
Next
Return retVal
End Function

Factorial function returning squared number and not factorial

Where is my code wrong? It is returning the square of any number:
Sub factorial()
Dim x As Long, i As Integer, fact As Long
x = InputBox("enter the integer")
For i = 1 To x
fact = i * x
Next i
MsgBox fact
End Sub
Practicing Loops and If Statements!?
Option Explicit
' If you are practicing (loops) then:
Sub factorial()
Dim x As Long, i As Long, fct As Double
x = InputBox("enter the integer")
If x >= 0 And x <= 170 Then
fct = 1
If x > 1 Then
For i = 2 To x
fct = fct * i
Next i
End If
MsgBox fct
Else
MsgBox "Next time enter a number between 0 and 170."
Exit Sub
End If
End Sub
' ...if not, just use Fact
Sub factorialExcel()
Dim x As Long
x = InputBox("enter the integer")
If x >= 0 And x <= 170 Then
MsgBox Application.WorksheetFunction.Fact(x)
Else
MsgBox "Next time enter a number between 0 and 170."
Exit Sub
End If
End Sub
One mistake is that fact needs to be initialized with fact=1 before it is used in the loop. Then inside the loop the result is should be multiplied by the iteration number, as in fact = fact * i. Lastly to make sure you get the highest possible range use the LongLong type (available in VB7 and above) which is a 64-bit integer. Oh, and don't forget to convert the text returned by InputBox to a number type.
Sub factorial()
Dim x As Long, i As Long, fact As LongLong
x = CLng(InputBox("enter the integer"))
fact = 1
For i = 1 To x
fact = fact * i
Next i
MsgBox fact
End Sub
PS. Never use Integer in VBA, but rather opt for the native 32-bit integer Long.
In your code the value of fact is recalculated on any iteration and it is not kept. So at the end, just the last value is shown, which is x*i where i=x, e.g. a square of the input. Something like this, using 90% of your code works:
Sub Factorial()
Dim x As Long, i As Long, fact As Long
x = 5
fact = 1
For i = 1 To x
fact = fact * i
Next i
Debug.Print fact
End Sub

Object required error when looping through cells in selection

I am looping through some cells, in a vertical selection, in Excel, and then passing that cell as a parameter to a procedure.
I have done it this way, so I don't have the contents of ProcessCells twice, in the code, once for the while loop, and the second time in the For loop.
If I try and get the value of the cell written out, in the for loop, it works.
If I put the contents of the ProcessCells procedure in the for loop, it also works.
But if I try to pass it as a parameter, into ProcessCells, I am getting an error
'Object Required'
Here is the code, if you want to check it out:
Sub loopThroughCells()
Dim c As Range
Dim autoSelect As String
Dim X, Y As Integer
autoSelect = Cells(3, 2).Value
If StrComp(autoSelect, "Y") = 0 Then
Y = 5
X = 4
While Not IsEmpty(Cells(Y, X).Value)
ProcessCells (Cells(Y, X))
Y = Y + 1
Wend
Else
For Each c In Selection
ProcessCells (c)
Next c
End If
End Sub
Sub ProcessCells(ce As Range)
End Sub
How is
Cells(n,m)
different from
c In Selection
?
The error happens in the For loop, but it doesn't happen in the while loop.
Here is how you should do it:
Option Explicit
Sub TestMe()
Dim c As Range
For Each c In Selection
Call ProcessCells(c)
Next c
End Sub
Sub ProcessCells(ce As Range)
End Sub
You should refer with call, because you have an argument in parenthesis.
Or like this, if you do not like the call:
Option Explicit
Sub TestMe()
Dim c As Range
For Each c In Selection
ProcessCells c
Next c
End Sub
Sub ProcessCells(ce As Range)
End Sub
Plus a small edition of your code. Make your declarations like this:
Dim X as Long, Y As long
In your code X is declared as a variant, and integer is slower and smaller than long - Why Use Integer Instead of Long?
Here is some good explanation when to put the argument in parenthesis and when to use the call - How do I call a VBA Function into a Sub Procedure

Is it possible to allow Integer Overflow in Excel VBA?

Pretty simple, but I couldn't find anything by Googling. An example of what I want to happen:
Function myFunc()
Dim a As Integer
Dim b As Integer
Dim c As Integer
a = 20000
b = 15000
c = a + b
myFunc = c
End Function
I want myFunc() to return -30536 instead of throwing an overflow exception. I know I could write a function that does that, but I've written a bunch of code for a project with the assumption that overflow was allowed, so I'm hoping there's a quick fix.
EDIT: I don't need help coming up with a function that solves the overflow issue with type conversions. I have one already; I just want to avoid changing hundreds of addition and subtraction operations. I'm also bit frustrated that VBA seems to go out of its way to disable overflow functionality--it should let the user decide if they want to use it or not.
I would suggest writing MyFunc to do the math as Long, and test for integer "overflow" and adjust
Function MyFunc(a As Integer, b As Integer) As Integer
Dim sum As Long
Const Mask As Integer = -1
sum = CLng(a) + CLng(b)
If sum > 32767 Then
sum = sum - 65536
ElseIf sum < -32768 Then
sum = sum + 65536
End If
MyFunc = sum
End Function
Test with
Sub zx()
Debug.Print MyFunc(20000, 15000)
End Sub
In order to prevent Integer overflow in your Excel VBA code, you may use the custom Function to perform the Integer to Long type casting like shown below:
Sub TestIntegerConversion()
Debug.Print myFuncLong(20000, 15000)
End Sub
Function myFuncLong(a As Integer, b As Integer) As Long
myFuncLong = CLng(a) + CLng(b)
End Function
or without using custom Function in a simple form like this:
Sub PreventOverflow()
Dim a As Integer
Dim b As Integer
a = 20000
b = 15000
Debug.Print CLng(a) + CLng(b)
End Sub
Alternatively, you may write your own custom function, which should implement that "overflow math" (you have somehow to specify using plain math notation how to get the number -30536 from 35000) and return the result either as Long, or String. Possible implementation is shown below (note: Overflow exception number is 6)
Sub OverflowCustomMath()
Dim a As Integer
Dim b As Integer
Dim c As Long
a = 20000
b = 15000
On Error GoTo Err:
Debug.Print a + b
Err:
If (Err.Number = 6) Then
'apply your custom overflow math, as for e.g.
Debug.Print CLng(a) + CLng(b)
End If
End Sub
Hope this may help.
Use typical VBA error handler but tests for your case.
Option Explicit
Sub test()
MsgBox myFunc
End Sub
Function myFunc()
On Error GoTo Local_err
Dim a As Integer
Dim b As Integer
Dim c As Integer
a = 20000
b = 15000
c = a + b
myFunc = c
Local_exit:
Exit Function
Local_err:
If Err = 6 Then
myFunc = -30536
Else
MsgBox Err & " " & Err.Description
' myFunc = whatever error value to return
End If
Resume Local_exit
End Function

Application defined or object defined error in VBA in passing parameter to a function

I'm trying to pass a worksheet variable to a function as its parameter. Here is the code
Public varcol as integer
Private Sub CommandButton2_Click()
Dim wrk as WorkSheet
If Range("A1") = "a" then
Set wrk = ThisWorkbook.Sheets("S1")
Call fun(wrk)
End If
End Sub
Function fun(ByVal wrk As Worksheet) As Double
Dim b As Integer
Dim w As Double
w = wrk.Cells(b, varcol).Value 'Line with the error
For b = 4 To 12
c = watt - w
If c < 1 Then
ah = Sheets("wrk").Cells(b, varcol - 1)
End If
Next b
End Function
Can someone tell what I'm doing wrong here...
In your "fun" Function, you declare wrk to be a worksheet, but you then use it inside quotation marks :
ah = Sheets("wrk").Cells(b, varcol - 1)
Instead, try replacing that last line with :
ah = wrk.Cells(b, varcol - 1)