I was wondering whether there is a smarter/more accurate method of debugging userform initializations in VBA that are called from a specific module.
Because when I write an erroneously piece of code in the Userform_initialisatize, I the error I receive states an error, but not where it occurs, the highlighted piece of code is simply call Userform_intitialize and I'm left guessing which piece of code in Sub Userform_intitialize contains the error.
So incrementally building a userform with test runs after every small addition of code work effectively to create a stable Userform initilisation code. Because I know what I changed since the last successful run, but it would save quite some time if I immediately know where the error occurs, especially in cases where trial runs consume a lot of time.
So are there ways to extract in which line the exact error occurs within a called Sub Userform_intitialize in vba Excel 2016?
As #A.S.H already mentioned the handler of Initialize event should remain private. Thats because the Initialize event itself is private so it is intended to be handled by the instances itself and not by anybody else.
So are there ways to extract in which line the exact error occurs within a called Sub Userform_intitialize in vba Excel 2016?
Regarding your question, yes it is still possible to extract the line number where the error occurred. But the lines needs to be part of the source code. Then the function VBA.Information.Erl can be used to get the line number. Example:
UserForm module
Option Explicit
Private Const MODULE_NAME As String = "MyUserForm."
Private Sub UserForm_Initialize()
On Error GoTo Error_In_UserForm_Initialize
1 Const procName As String = "UserForm_Initialize"
' Some code here
2 Dim d As Date
3 d = Now
4 MsgBox "Hi from my userform! 'Now' is '" & d & "'", vbInformation, "Info"
' Here error occures, max. value of Integer is 32.767
5 Dim i As Integer
6 i = 40000
7 Exit Sub
Error_In_UserForm_Initialize:
8 Dim errorDescription As String
9 With Err
10 errorDescription = "Error '" & .Number & "'" & _
" with description '" & .Description & "'" & _
" occured in procedure '" & MODULE_NAME & procName & "'" & _
IIf(Erl <> 0, " on line '" & CStr(Erl) & "'.", ".")
11 End With
12 MsgBox errorDescription, vbCritical, "Error"
End Sub
Some additional readings about Erl here or here.
Related
I am trying to make my excel macro dynamic. The excel macro essentially looks at only 2 columns, one which contains the name and the other contains the numeric part. I have my macro working perfectly, the only problem is that it is hard coded when I created the program. In my code, I hard coded the name in column 2 and the numeric part in column 3. However, that is not the case in real life. The name and numeric data could appear in column 1 and 5, for example. I've been manually rearranging the data in the columns so that it fits into what hard coded. However, I want to make this process dynamic and less manual work for the user.
There are 5 different versions of spreadsheets this macro will be used on and in each spreadsheet, the name and number columns are different. I am looking to make a user form box of some sort, where the user selects "Vendor XYZ" and since Vendor XYZ always sends their data sheets the same way I know that Vendor XYZ's name column is 2 and number is 4. So I was thinking that the dictionary would be something in the form of {Vendor XYZ: 2,4} (where the first number is the name column and the second number is the numeric columnnumber...I know the syntax is wrong)
I think my work around this would be to hard code the different vendors and then use if statements ( I haven't tried it yet)
I will have a user input/dropdown box of 5 different vendors. Then something like
If userinput="A"
then namecol=2 and numcol=1
If userinput="B"
then namecol="3" and numcol="4"
I don't know if that would even work. The problem with that is that the number of vendors is small now, but will be scaling up and I can't do that if we have 100 or 1000 vendors.
Any ideas?
Depending on how your initial dataset is retrieved, you can use something like this:
Public Function GetHeaderIndices(ByVal InputData As Variant) As Scripting.Dictionary
If IsEmpty(InputData) Then Exit Function
Dim HeaderIndices As Scripting.Dictionary
Set HeaderIndices = New Scripting.Dictionary
HeaderIndices.CompareMode = TextCompare
Dim i As Long
For i = LBound(InputData, 2) To UBound(InputData, 2)
If Not HeaderIndices.Exists(Trim(InputData(LBound(InputData, 1), i))) Then _
HeaderIndices.Add Trim(InputData(LBound(InputData, 1), i)), i
Next
Set GetHeaderIndices = HeaderIndices
End Function
This Function takes an array as an input and gives the user a dictionary with the indices of the headers from the input.
If you are smart (and I say this because too many users just don't use tables) you will have your data in a table, and you will have named that table. If you did, you could do something like this:
Sub DoSomething()
Dim MyData as Variant
MyData = ThisWorkbook.Worksheets("MyDataSheet").ListObjects("MyTableName").Range.Value
End Sub
So, if you data looked like this:
Foo Baz Bar
1 Car Apple
3 Van Orange
2 Truck Banana
The function would give you a dictionary like:
Keys Items
Foo 1
Baz 2
Bar 3
Then your subroutines could do something like this:
Sub DoEverything()
Dim MyData as Variant
MyData = ThisWorkbook.Worksheets("MyDataSheet").ListObjects("MyTableName").Range.Value
DoSomething(MyData)
End Sub
Sub DoSomething(ByRef MyData as Variant)
Dim HeaderIndices as Scripting.Dictionary
Set HeaderIndices = GetHeaderIndices(MyData)
Dim i as Long
' Loop through all the rows after the header row.
For i = LBound(MyData, 1) + 1 to Ubound(MyData, 1)
If MyData(i, HeaderIndices("Baz")) = "Truck" Then
?MyData(i, HeaderIndices("Foo"))
?MyData(i, HeaderIndices("Baz"))
?MyData(i, HeaderIndices("Bar"))
End If
Next
End Sub
This does require a reference to Scripting.Runtime so if you don't want to add a reference you will need to change any reference to As Scripting.Dictionary to As Object and any New Scripting.Dictionary to CreateObject("Scripting.Dictionary").
Alternatively, I use the following code module to take care of adding references programmatically for all my users:
Public Sub PrepareReferences()
If CheckForAccess Then
RemoveBrokenReferences
AddReferencebyGUID "{420B2830-E718-11CF-893D-00A0C9054228}"
End If
End Sub
Public Sub AddReferencebyGUID(ByVal ReferenceGUID As String)
Dim Reference As Variant
Dim i As Long
' Set to continue in case of error
On Error Resume Next
' Add the reference
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:=ReferenceGUID, Major:=1, Minor:=0
' If an error was encountered, inform the user
Select Case Err.Number
Case 32813
' Reference already in use. No action necessary
Case vbNullString
' Reference added without issue
Case Else
' An unknown error was encountered, so alert the user
MsgBox "A problem was encountered trying to" & vbNewLine _
& "add or remove a reference in this file" & vbNewLine & "Please check the " _
& "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
End Select
On Error GoTo 0
End Sub
Private Sub RemoveBrokenReferences()
' Reference is a Variant here since it requires an external reference.
' It isnt possible to ensure that the external reference is checked when this process runs.
Dim Reference As Variant
Dim i As Long
For i = ThisWorkbook.VBProject.References.Count To 1 Step -1
Set Reference = ThisWorkbook.VBProject.References.Item(i)
If Reference.IsBroken Then
ThisWorkbook.VBProject.References.Remove Reference
End If
Next i
End Sub
Public Function CheckForAccess() As Boolean
' Checks to ensure access to the Object Model is set
Dim VBP As Variant
If Val(Application.Version) >= 10 Then
On Error Resume Next
Set VBP = ThisWorkbook.VBProject
If Err.Number <> 0 Then
MsgBox "Please pay attention to this message." _
& vbCrLf & vbCrLf & "Your security settings do not allow this procedure to run." _
& vbCrLf & vbCrLf & "To change your security setting:" _
& vbCrLf & vbCrLf & " 1. Select File - Options - Trust Center - Trust Center Settings - Macro Settings." & vbCrLf _
& " 2. Place a checkmark next to 'Trust access to the VBA project object model.'" _
& vbCrLf & "Once you have completed this process, please save and reopen the workbook." _
& vbCrLf & "Please reach out for assistance with this process.", _
vbCritical
CheckForAccess = False
Err.Clear
Exit Function
End If
End If
CheckForAccess = True
End Function
And I have the following command in each Workbook_Open event (less than ideal, but only good solution I have so far)
Private Sub Workbook_Open()
PrepareReferences
End Sub
Is it possible to create Excel VBA macro from a string variable?
Suppose we have FirstMacro:
Sub FirstMacro()
Dim MyString
MyString = "Sub SecondMacro()" & Chr(13) & Chr(10) & "MsgBox " & Chr(34) & "Hello" & Chr(34) & Chr(13) & Chr(10) & "End Sub"
Debug.Print MyString
'Here be code that magicly creates SecondMacro
End Sub
Running the macro, I want to create SecondMacro which is stored in VBA string variable. The second macro can be created either below in the same module or in a new module.
So the second macro from string looks like this:
Sub SecondMacro()
MsgBox "Hello"
End Sub
Sure is possible. It should be noted that you can't add/delete from the module you're running code in.
This will append the code at the end of the module. If you can avoid this though you should, I only use it for adding code to buttons that I've added programatically.
With Workbooks(ThisWorkbook.Name).VBProject.VBComponents("MyModuleHere").CodeModule
.InsertLines .CountOfLines + 1, "Sub... End Sub"
End With
So to add to the "MyModuleHere" code module (assuming you have a module named that), drop this in:
Sub addcode()
Dim subtext As String
subtext = "Sub PrintStuff" & vbCrLf & "msgbox ""Hello World""" & vbCrLf & "End Sub"
With Workbooks(ThisWorkbook.Name).VBProject.VBComponents("MyModuleHere").CodeModule
.InsertLines .CountOfLines + 1, subtext
End With
End Sub
As usual, CPearson adds some really useful insight:
http://www.cpearson.com/excel/vbe.aspx
With regard to removing code, which I think you're hinting at in your comment, I use the below function to find a sub name, and remove it (this assumes that I will know the length of the sub):
Function ClearModule(strShapeName As String)
Dim start As Long
Dim Lines As Long
Dim i As Variant, a As Variant
With Workbooks(ThisWorkbook.Name).VBProject.VBComponents("MyModuleHere").CodeModule
For i = .CountOfLines To 1 Step -1
If Left(.Lines(i, 1), 8 + Len(strShapeName)) = "Sub " & strShapeName & "_Cli" Then
.DeleteLines i, 6
End If
Next
End With
End Function
Here you have more or less all variations which, hopefully, will solve your problem. To test this code copy all of it in a normal code module (by default "Module1") Rename it as "Remin" and write "FirstMacro" in cell A1 of the worksheet you activate, a number in cell A2. Then run the first of the following procedures directly from the VBE window.
Sub SelectMacroToRun()
' 04 Apr 2017
Dim MacroName As String
Dim Arg1 As String
Dim Outcome As Long
With ActiveSheet
MacroName = .Cells(1, 1).Value
Arg1 = .Cells(2, 1).Value
End With
On Error Resume Next
Outcome = Application.Run(ActiveSheet.name & "." & MacroName, Arg1)
If Err Then
MsgBox "The macro """ & MacroName & """ wasn't found", _
vbInformation, "Error message"
Else
If Outcome <> xlNone Then MsgBox "Outcome = " & Outcome
End If
End Sub
Private Function FirstMacro(Optional ByVal Dummy As String) As Long
MsgBox "First Macro"
FirstMacro = xlNone
End Function
Private Function SecondMacro(Arg1 As Long) As Long
MsgBox "Second Macro" & vbCr & _
"Argument is " & Arg1
SecondMacro = Arg1 * 111
End Function
The code will run the FirstMacro, reading the name from the worksheet. Change that name to "SecondMacro" to call the second macro instead. The second macro requires an argument, the first only accepts it and does nothing with it. You don't need to pass any argument, but this code shows how to pass (as many as you want, comma separated) and it also shows how to ignore it - the argument is passed to a dummy variable in the FirstMacro, and the function also returns nothing.
Application.Run "Remin" & MacroName, Arg1
Would just run the macro (it could be a sub). Omit the argument if you don't want to pass an argument. "Remin" is the name of the code sheet where the called macro resides. This name could be extended to include the name of another workbook. However, if the called macro isn't in the same module as the caller it can't be Private.
I have some code which looks for a value with a given sheet name in two separate workbooks.
What I want to do is when the first workbook does not have the sheet, instead of the following prompt coming up, it cancels/throws an error and using the error handling goes to the second spreadsheet. How do I do this?
Currently I am using this code to achieve this:
fFormString1 = "'" & wkBookRef1 & firstShtName & "'!$L$6/1000"
fFormString2 = "'" & wkBookRef2 & firstShtName & "'!$L$6/1000"
Application.DisplayAlerts = False 'Does nothing to the prompt
On Error GoTo tryTwo 'Following only throws error when prompt is canceled
ThisWorkbook.Sheets("Place").Range("E53").Formula = "=" & fFormString1
GoTo endTen
tryTwo:
ThisWorkbook.Sheets("Place").Range("E53").Formula = "=IFERROR(" & fFormString2 & ","""")"
On Error Resume Next
endTen:
Application.DisplayAlerts = True 'Does nothing to the prompt
Note: I wish to do this with the spreadsheet closed ideally. Or visually not present to improve speed and smoothness of operation for my client.
ExecuteExcel4Macro will return a value from a closed workbook. If the worksheet doesn't exist it will throw an error 1004 'A formula in this worksheet contains one or more invalid references.
ExternalWorksheetExists uses this to test it the worksheet exist.
Function ExternalWorksheetExists(FilePath As String, FileName As String, WorksheetName As String) As Boolean
If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
On Error Resume Next
Call ExecuteExcel4Macro("'" & FilePath & "[" & FileName & "]" & WorksheetName & "'!R3C3")
ExternalWorksheetExists = Err.Number = 0
On Error GoTo 0
End Function
When using ExecuteExcel4Macro, all references must be given as R1C1 strings. Here is an example of a valid string:
ExecuteExcel4Macro("'C:\Users\tinzina\Documents\[Book1.xlsm]Sheet1'!R6C12")
Borrowing heavily from Thomas' answer (full credit is due). However it seems that this didn't work for you.
Use ExecuteExcel4Macro but ascribe the value to the variable val. Then check if this is the error you are looking for Error(2023).
Please find the code below:
'Check if the sheet exists in the workbook, used to check which forecast file one should look in
Function ExtSheetExists(formString) As Boolean 'Form string is a formula string with both the worksheet and the workbook
Dim val As Variant
'Tries to execute formula and throws error if it doesn't exist
On Error Resume Next
val = ExecuteExcel4Macro(formString)
ExtSheetExists = (val <> Error(2023)) 'Returns False if the sheet does not exist based on Error 2023
On Error GoTo 0
End Function
So I'm another one of those wanting to use the ExecuteExcel4Macro Method call to retrieve data from specific cells and lookup ranges in closed workbooks. I have seen lots of examples and answers to problems here and elsewhere. I am (or will be) using a variation of a routine credited to John Walkenbach, and referenced here and on other forums. (See thread for 9311188.)
The call to ExecuteExcel4Macro fails with an error "1004 - Method 'ExecuteExcel4Macro' of object '_Global' failed". For me, that's not a lot to go on. I have double checked the directory paths, file and sheet names, all that. The DIR() function finds the file okay. I've even put the files in the root directory to eliminate path complexities or too-long of an argument to the Method. One complication is that I'm on a Mac with OS 10.8 and using Excel 2011. Mac OS uses ":" instead of "" for directory delimiters.
But I don't really need to get into all that because the problem seems to be something fundamental about the cell reference addressing. I can't get ExecuteExcel4Macro to execute successfully within the same worksheet with an Excel Function that addresses any cell or range, never mind about a remote, closed worksheet reference. So I have condensed my example code to the essentials – no remote reference, just functions on cells in one worksheet.
In the example below I have a simple routine that executes some sample Excel Functions and displays a MessageBox with either the successful result or the error message, along with the argument to the Method call. There's also a function that will convert the A1 style references to R1C1 when needed. The list of Functions are within the routine, just comment/uncomment as needed to execute whichever one to test.
Function MakeR1C1(A1Formula As String) As String
MakeR1C1 = Application.ConvertFormula( _
Formula:=A1Formula, _
fromReferenceStyle:=xlA1, _
toReferenceStyle:=xlR1C1, _
ToAbsolute:=xlAbsolute)
End Function
Sub TestExcel4Macro()
On Error GoTo ErrorTrap
Dim arg As String
' arg = "GET.CELL(42)"
' arg = "CHAR(65)"
' arg = "LEN(""ABCDE"")"
' arg = "SUM(2,5,8)"
' arg = "INFO(""directory"")"
' arg = "INFO(""numfile"")"
' arg = "SUM(A32:A34)"
' arg = "SUM(ValList)"
' arg = MakeR1C1("SUM(A32:A34)")
' arg = "SUM(R32C1:R34C1)"
Rtn = ExecuteExcel4Macro(arg)
MsgBox "COMPLETED" & Chr(13) & _
"arg: " & arg & Chr(13) & _
"Return Value: " & Rtn
Exit Sub
ErrorTrap:
Beep
MsgBox "FAILED" & Chr(13) & _
"arg: " & arg & Chr(13) & _
"Error number: " & Err & Chr(13) & _
Error(Err)
End Sub
The first six all work just fine, returning the values you would expect:
arg = "GET.CELL(42)" This returns the left margin, or whatever that is;
arg = "CHAR(65)" Good, you get an "A" for that;
arg = "LEN(""ABCDE"")" Nice, that's a 5;
arg = "SUM(2,5,8)" Okay, 15;
arg = "INFO(""directory"")" Yep, the directory path of the active workbook with the macro;
arg = "INFO(""numfile"")" And the number of sheets in the workbook (plus 1? whatever).
So from this I know I'm accessing the Method correctly; it does work; you don't use the "=" in the argument; and the two INFO() Functions tell me it's able to access info about this workbook; i.e. it doesn't require explicit full directory pathway to find itself.
Now some functions that make reference to cells in the worksheet. These all work fine as a Formula in a cell in the worksheet.
But they fail as a call to the Method, with the respective error codes:
arg = "SUM(A32:A34)" 13 - Type mismatch
As expected, the Method requires R1C1 style references.
arg = "SUM(ValList)" 13 - Type mismatch
Okay, not too surprising, so it won't work with a named range. Too bad, I was counting on that.
arg = MakeR1C1("SUM(A32:A34)") 1004 - Method 'ExecuteExcel4Macro' of object '_Global' failed
Now the puzzlement. The MakeR1C1() converts the A1 addressing okay to "SUM(R32C1:R34C1)".
arg = "SUM(R32C1:R34C1)" 1004 - Method 'ExecuteExcel4Macro' of object '_Global' failed
And setting the argument explicitly with the R1C1 style fails the same.
I'll be really embarrassed if this is due to something simple and obvious. But I'll risk it because I'm stumped.
If it's not so simple then, Gurus, have at it. If I get this simple reference addressing problem figured out, then the remote file reference should fall into place, too.
I'll be especially appreciative of anyone who can test these in a Windows version and let me know what you get. That's what I'm most worried about – a Mac incompatibility that I can't fix.
Thanks to all in advance.
PS: I hope I have marked up all the above correctly, I tried.
Edit: Maybe I should have mentioned that to run my TestExcel4Macro() subroutine, I just mash the F5 key while in the VBA editor.
Quote:
The Microsoft Excel 4.0 macro isn't evaluated in the context of the
current workbook or sheet. This means that any references should be
external and should specify an explicit workbook name. For example, to
run the Microsoft Excel 4.0 macro "My_Macro" in Book1 you must use
"Book1!My_Macro()". If you don't specify the workbook name, this
method fails.
Here is what worked for me (MS Excel 2010 under Windows smthg): you have to specify the workbook + Sheet before referring to the Cells; and also make the R1C1 conversion.
Sub TestExcel4Macro()
On Error GoTo ErrorTrap
Dim arg As String
Dim this_workbook As String
' workbook named "myBook" having a sheet called "mySheet" where my data is
this_workbook = "[myBook.xlsm]mySheet!"
arg = "SUM(" & this_workbook & "A32:A34)"
arg = MakeR1C1("SUM(A32:A34)")
Rtn = ExecuteExcel4Macro(arg)
MsgBox "COMPLETED" & Chr(13) & _
"arg: " & arg & Chr(13) & _
"Return Value: " & Rtn
Exit Sub
ErrorTrap:
Beep
MsgBox "FAILED" & Chr(13) & _
"arg: " & arg & Chr(13) & _
"Error number: " & Err & Chr(13) & _
Error(Err)
End Sub
Have you tried defining arg as Variant instead of String?
I'm trying to call a function with a variable name that is generated at run time based upon a combo box value. This is straightforward in most languages but I can't seem to figure it out in Excel VBA, I suspect this is because I don't really understand how the compiler works. I've found several posts that are close but don't quite seem to do the trick. The code below is wrong but should give an idea of what I want.
Thanks
Sub main()
'run formatting macros for each institution on format button click
Dim fn As String
Dim x As Boolean
'create format function name from CB value
fn = "format_" & CBinst.Value
'run function that returns bool
x = Eval(fn)
...
End Sub
CallByName is what you'll need to accomplish the task.
example:
Code in Sheet1
Option Explicit
Public Function Sum(ByVal x As Integer, ByVal y As Integer) As Long
Sum = x + y
End Function
Code is Module1 (bas module)
Option Explicit
Sub testSum()
Dim methodToCall As String
methodToCall = "Sum"
MsgBox CallByName(Sheet1, methodToCall, VbMethod, 1, 2)
End Sub
Running the method testSum calls the method Sum using the name of the method given in a string variable, passing 2 parameters (1 and 2). The return value of the call to function is returned as output of CallByName.
You should write a function that accepts the CB value as a parameter and then uses a select case to call the appropriate formatting function.
Something similar to this
Function SelectFormatting(Name as String) As Boolean
Select Case CBinst.Value
Case "Text1":
SelectFormatting = Text1FormattingFunction()
Case "Text2":
.
.
.
End Select
End Function
The above will work but not with a large number of names
Use Application.Run(MacroName, Parameters)
You have to may sure that there is a macro but it is better than the above as there is no select statement.
With respect to my answer above you might also find this useful to check whether the macro exists
'=================================================================================
'- CHECK IF A MODULE & SUBROUTINE EXISTS
'- VBA constant : vbext_pk_Proc = All procedures other than property procedures.
'- An error is generated if the Module or Sub() does not exist - so we trap them.
'---------------------------------------------------------------------------------
'- VB Editor : Tools/References - add reference TO ......
'- .... "Microsoft Visual Basic For Applications Extensibility"
'----------------------------------------------------------------------------------
'- Brian Baulsom October 2007
'==================================================================================
Sub MacroExists()
Dim MyModule As Object
Dim MyModuleName As String
Dim MySub As String
Dim MyLine As Long
'---------------------------------------------------------------------------
'- test data
MyModuleName = "TestModule"
MySub = "Number2"
'----------------------------------------------------------------------------
On Error Resume Next
'- MODULE
Set MyModule = ActiveWorkbook.VBProject.vbComponents(MyModuleName).CodeModule
If Err.Number <> 0 Then
MsgBox ("Module : " & MyModuleName & vbCr & "does not exist.")
Exit Sub
End If
'-----------------------------------------------------------------------------
'- SUBROUTINE
'- find first line of subroutine (or error)
MyLine = MyModule.ProcStartLine(MySub, vbext_pk_Proc)
If Err.Number <> 0 Then
MsgBox ("Module exists : " & MyModuleName & vbCr _
& "Sub " & MySub & "( ) : does not exist.")
Else
MsgBox ("Module : " & MyModuleName & vbCr _
& "Subroutine : " & MySub & vbCr _
& "Line Number : " & MyLine)
End If
End Sub
'-----------------------------------------------------------------------------------