How do I make my subs() not change inputdata in Vba excel - excel

When I call a sub and pass a variable, after the sub ends the passed variable is changed. How do I make it not do that?
So in the example the debug.print should be 3 not 8
sub main()
i = 3
SomeSub i
debug.print i
end sub
sub SomeSub(j)
j=j+5
end sub

Just use the ByVal keyword to pass on the value
Sub SomeSub(ByVal j As Long)
j = j + 5
End Sub
Further reading
Using ByRef and ByVal
When we pass a simple variable to a procedure we can pass using ByRef
or ByVal.
ByRef means we are passing the address of the variable. If the
variable changes in the procedure the original will also be changed.
ByVal means we are creating a copy of the variable. If the variable
changes in the procedure the original will not be changed.

Related

Get the last user who edit the Excel through VBA?

I want to show the last editor's name in the Excel file, because there are some models that can be used by all department members.
Is it possible to get the last editor's name who edited the Excel through Excel VBA?
I think the easiest way to do this is to use this built-in function.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
User = Application.UserName
'Save the user and probably date time in wherever you want
End Sub
You need to insert the code inside 'ThisWorkbook' module:
You may benefit from the built-in property "last author" which gets refreshed with each saving and can be read by the following function:
Private Function LastAuthor() As String
Dim prop As Object
On Error Resume Next
Set prop = ThisWorkbook.BuiltinDocumentProperties("last author")
If Err.Number = 0 Then
LastAuthor = prop.Value
Else
LastAuthor = "Not yet documented!"
End If
End Function
Another built-in property of interest might be "Last save time".
you can create a macros for the event Workbook_Open that writes a current username in some log file. On https://support.microsoft.com they have a sub to get the current username
' Makes sure all variables are dimensioned in each subroutine.
Option Explicit
' Access the GetUserNameA function in advapi32.dll and ' call the function GetUserName.
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
' Main routine to Dimension variables, retrieve user name
' and display answer.
Sub Get_User_Name()
' Dimension variables
Dim lpBuff As String * 25
Dim ret As Long, UserName As String
' Get the user name minus any trailing spaces found in the name.
ret = GetUserName(lpBuff, 25)
UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
' Display the User Name
MsgBox UserName
End Sub

Why are the change and selection change events use byval? [duplicate]

This question already has answers here:
Collection Object - ByRef - ByVal
(1 answer)
Do I need to pass a worksheet as ByRef or ByVal?
(1 answer)
Closed 1 year ago.
Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
On the internet byRef and byVal are differentiated by saying byRef points to a reference and byVal creates a new reference and copies the values from the original. So when you change the passed variable it does not effect the original variable.
But if this is accurate why are the worksheet events such as change and selection_change use byVal. Wouldn't that mean the code should not be able to manipulate the values of the ranges that are being selected. After all byVal should not be able to change the original values only the copies it creates. Yet if you write something like,
Private Sub Worksheet_Change(ByVal Target As Range)
Target.Font.Color = VBA.ColorConstants.vbBlue
End Sub
Anything written in the selected range will actually change their color. So what is really going on here?
You must know that ByVal still passes references. Even if you get a copy to a referenced object.
Inside of the procedure/event called ByVal you can use the referenced object and change its properties. Such a simple event, works based on what I stated in my first item:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Interior.Color = vbYellow
End Sub
You practically work with the same object instance (in memory). Only the reference is copied. You can use it inside the sub called ByVal.
The behavior of the variable acts as you tried stating when you use a custom variable and expect to afect somehow (or not) the initial variable value but after calling other Subs handling it.
Please, look to the next example and see how the initial variable is changed in case of the two different processing Subs:
Sub testByValSub()
Dim x As String
x = "myString"
Debug.Print x
changeStrBV x
Debug.Print "After ByVal: " & x
changeStrBR x
Debug.Print "After ByRef: " & x
End Sub
Sub changeStrBV(ByVal x)
x = x & " and something else"
'do whatever you want with x, but only here...
End Sub
Sub changeStrBR(ByRef x)
x = x & " and something else"
End Sub

How to call an Excel custom ribbon button from the immediate window?

Having a procedure c1(), that looks like this:
Sub c1(control As IRibbonControl)
Debug.Print "foo"
End Sub
it is being called successfully from the ribbon, with the correct code onAction="c1"/>
Question:
How to call the same procedure from the immediate window (for debugging purposes)? It is asking for a parameter, which I do not know how to provide:
If your code in c1 does not rely on the control you can use
c1 nothing
in the immediate window.
What you can do for example:
Private lobjRibbon As IRibbonUI
Public Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
ByRef Destination As Any, ByRef source As Any, ByVal length As Long)
Public Sub Ribbon_CallbackOnLoad(ByRef probjRibbon As IRibbonUI)
Set lobjRibbon = probjRibbon
Range("A1").Value = CStr(ObjPtr(lobjRibbon)) 'write the pointer to a cell to save it even if VBA stops
End Sub
with Ribbon_CallbackOnLoad you set the ribbon on load to the variable lobjRibbon or save it's pointer (in case VBA completely ends).
You can use
Function GetRibbon(ByVal lRibbonPointer As LongPtr) As Object
Dim objRibbon As Object
Call CopyMemory(objRibbon, lRibbonPointer, LenB(lRibbonPointer))
Set GetRibbon = objRibbon
Set objRibbon = Nothing
End Function
to get the ribbob object back from its saved pointer for example like in
Sub RefreshRibbon(Optional ControlID As String = vbNullString)
If lobjRibbon Is Nothing Then
Set lobjRibbon = GetRibbon(CLngPtr(Range("A1").Value))
If ControlID = vbNullString Then
lobjRibbon.Invalidate
Else
lobjRibbon.InvalidateControl ControlID
End If
Else
If ControlID = vbNullString Then
lobjRibbon.Invalidate
Else
lobjRibbon.InvalidateControl ControlID
End If
End If
End Sub
Try this workaround
Sub c1(control As IRibbonControl)
call c1_subroutine
End Sub
Sub c1_subroutine()
Debug.Print "foo"
End Sub
And in the immediate window call c1_subroutine

Excel VBA Which UserForm Control Triggered Shared MouseOver Class Event?

How do I return the name of the userform control that triggered the mouseover class event?
This sounds so simple but honestly I've been racking my brain trying to find the correct syntax...
Here is my userform module:
Option Explicit
Dim dArray() As New Class1
Sub Build_Controls()
Dim dImage As Object, i As Integer
For i = 1 To 3
Set dImage = UserForm1.Controls.Add("Forms.Image.1", i, True)
With dImage
.Left = (25 * i) + 20
.Width = 20
.Top = 10
.Height = 20
End With
ReDim Preserve dArray(1 To i)
Set dArray(i).dImages = dImage
Next i
End Sub
Private Sub UserForm_Activate()
Build_Controls
End Sub
I dynamically create three image controls at runtime aptly named "1", "2", and "3".
I assign each control a mouseover event found in the following class module called "Class1":
Public WithEvents dImages As MSForms.Image
Private Sub dImages_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
MsgBox ("Control Name") 'Which control was triggered?
End Sub
How can I make the MsgBox contain the name of the control that triggered the event?
Me.dImages.Name 'x
ActiveControl.Name 'x
Screen.ActiveControl.Name 'x
UserForm1.ActiveControl.Name 'x
Any help is appreciated.
Thanks,
Mr. J
use this in the class module
do not use msgbox because it puts the VBA editor into background
use Debug.Print, then you can watch the values change on the fly in the immediate window
put a breakpoint at the debug.print line and then examine the dImages object in the watch window ( that is how i got the name attribute )
Option Explicit
Public WithEvents dImages As MSForms.Image
'
Private Sub dImages_Click()
Debug.Print dImages.Name
End Sub
'
Private Sub dImages_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Debug.Print dImages.Name
End Sub
EDIT: seems like I mis-read your question, but
Msgbox dImages.Name
works for me /EDIT
Msgbox dImages.Parent.Name
or something like that - you have a reference to the control in dImages, so you just need to go "up" from there.
If the control isn't hosted directly on the form then you will need to go "up" using .Parent until the parent is not another control:
Dim tmp As Object
Set tmp = dImages.Parent
Do While TypeOf tmp Is MSForms.Control
Set tmp = tmp.Parent
Loop
MsgBox tmp.Name
https://www.mrexcel.com/forum/excel-questions/758496-get-userform-given-control.html

Passing Variant ByRef in VBA Excel 2007

I have a public Variant variables declared in a UserForm called MainForm
Public increaseArray As Variant
Public countryArray As Variant
Then in sub on button click for the MainForm:
Sub testButton_Click()
Dim country As Variant
Set countryArray = Module1.callSomeFunctionThatReturnsVariant(1)
Set increaseArray = Module1.callSomeFunctionThatReturnsVariant(2)
For Each country In countryArray
Call Module1.createPage(country)
Next country
End Sub
In Module1 I have:
Function callSomeFunctionThatReturnsVariant(ByVal testInt As Integer) As Variant
.... do something when testInt = 1
.... do something when testInt = 2
callSomeFunctionThatReturnsVariant = someVariant
End Function
Public Sub createPage(ByVal country As String)
Dim testInt As Integer
... do something
testInt=insertSection(country, MainForm.increaseArray)
End Sub
Function insertSection(ByVal country As String, arr as Variant) As Integer
Dim arrCountry As Variant
For Each arrCountry In arr
If country = "France" Then
...do something
insertSection = 1
Exit Function
End If
Next arrCountry
insertSection = 2
End Function
I get ByRef argument type mismatch error when passing MainForm.increaseArray to insertSection() function. I've tried using Function insertSection(ByVal country As String, ByVal arr as Variant) As Integer but I get same error.
If I try to define a Variant variable in createPage sub Dim testArray As Variant and get the increaseArray from its getter function Set testArray = MainForm.getterForIncreaseArray I get type mismatch error...
If I pass getter function directly to caller of insertSection function I get ByRef argument type mismatch...
Please help :)
this simple code works fine.
declaring public array in userform not allowed (so using variant as disguise was good idea).
But then, Functions dont want to accept passing it as argument as a legit array, so i used a temporary 'legit' array.
on UserForm1 :
Option Explicit
Public a As Variant 'i would usually declare it like this : Public a() as variant, but public arrays not allowed in userforms (throws error)
'Private a() as variant , would not throw error (inside userform)
Private Sub UserForm_Initialize()
Dim i&
ReDim a(1 To 2) 'absolutely needed, it shows a is actually an array type
a(1) = 1
a(2) = 2
End Sub
Private Sub UserForm_Terminate()
Erase a
End Sub
in a module :
Option Explicit
Sub test()
Load UserForm1
Dim b&
Call get_value(1, UserForm1.a, b)
Unload UserForm1
MsgBox b
End Sub
Sub get_value(ByVal i&, ByRef arr As Variant, ByRef answer As Long) ' function won't let it through, i used a sub with aditionnal variable as Byref.
answer = arr(i)
End Sub
Launch it by calling TEST.
Note : i didn't succeed in passing argument in a Function, so did it in a SUB by adding an argument called Answer, wich is Byref.
Note2 : i looked back at my older code, and it would seem that you can pass a byref Array (disguised as variant) in a function , but maybe because this one is declared not with () or whatever, it don't want to work through a function.
Note 3 : after thurther digging into it, i found a solution using function, and as i thought, the array-declaring was the troublemaker :
'in a module (use the same userform as before)
Sub test()
Load UserForm1
Dim b&
Dim i& 'counter
Dim Temp_Array() As Long 'as variant works too, but i filled it with numbers so as long is ok too
ReDim Temp_Array(LBound(UserForm1.a) To UBound(UserForm1.a))
'Temp_Array = UserForm1.a 'damn, i first thought this would work, in the same way you can fill a listbox in one simple line (wich would be a 3rd solution passing an array from the userform to a module)
For i = LBound(UserForm1.a) To UBound(UserForm1.a)
Temp_Array(i) = UserForm1.a(i)
Next i
b = get_value(1, Temp_Array)
Erase Temp_Array
Unload UserForm1
MsgBox b
End Sub
Function get_value(ByVal i&, ByRef arr As Variant) As Long
get_value = arr(i)
End Function
As per findwindow's comment. You can't make use of things in module 1 from within the form as it's beyond its scope. Instead, try putting all the code from module1 into a new class module. Instantiate an instance of that from within your form and it should work ok.

Resources