Loop until element equals to specific text in drop down - excel

I have the following piece of code
Do
On Error Resume Next
.FindElementById("ContentPlaceHolder1_DropDownListl2").AsSelect.SelectByText ("txt")
On Error GoTo 0
Loop Until .FindElementById("ContentPlaceHolder1_DropDownListl2").AsSelect.SelectedOption.Text = "txt"
I have a lot of drop down lists that I deal with them with the same approach and although I used On Error Resume Next, I got errors sometimes and I have to wait a little and click Resume to resume the code execution
Can I make this as public procedure as I will use such lines a lot with other elements?
And how I can avoid the errors? and of course at the same time get my target for selecting the desired text in the drop down
Here's a snapshot of one of the errors
Based on #QHarr reply I tried to make a public procedure like that
Sub WaitElement(driver As Selenium.WebDriver, sElement As SelectElement, txt As String)
Dim t As Date
Const MAX_SEC As Long = 30
With driver
On Error Resume Next
t = Timer
Do
DoEvents
sElement.AsSelect.SelectByText txt
If Timer - t > MAX_SEC Then Exit Do
Loop Until sElement.AsSelect.SelectedOption.Text = txt
On Error GoTo 0
End With
End Sub
But when trying to use it in that way
WaitElement bot, .FindElementById("ContentPlaceHolder1_DropDownListnat"), ws.Range("B11").Value
I got 'Run-time error 13' (Type mismatch)
After applying the UDF named 'TextIsSet' I got this error
and the same problem.. if I click on Debug then Resume then wait a little, the code resumes its work
I have used such lines too but doesn't help
Do
Loop While .FindElementsById("ContentPlaceHolder1_Dschool").Count = 0
I got the same last error of not founding such an element

This can happen when an action causes a change to the DOM. The lazy way is to add a timed loop to try for that element until that error goes away or time out reached. You could also try shifting the On Error to surround the loop instead of inside the loop and then add in a time out. This is a little brutal but without a webpage to test with.
As a function call (this feels ugly and you may find webElements don't like being passed around):
Option Explicit
Public Sub test()
Const MAX_WAIT_SEC As Long = 30
'other code
If TextIsSet(dropdown, expectedText, MAX_WAIT_SEC) Then
End If
End Sub
Public Function TextIsSet(ByRef dropdown As Object, ByVal expectedText As String, ByVal MAX_WAIT_SEC As Long) As Boolean
Dim t As Date
On Error Resume Next
t = Timer
Do
DoEvents
dropdown.AsSelect.SelectByText expectedText
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop Until dropdown.AsSelect.SelectedOption.Text = expectedText
If dropdown.AsSelect.SelectedOption.Text = expectedText Then
TextIsSet = True
Else
TextIsSet = False
End If
On Error GoTo 0
End Function
I don't have a stale element test case so I just used a drop down test case:
Option Explicit
Public Sub test()
Const MAX_WAIT_SEC As Long = 30
Dim d As WebDriver, expectedText As String, dropdown As Object
'expectedText = "AL - Alabama" ''Pass Case
expectedText = "Bananaman" 'Fail Case
Set d = New ChromeDriver
With d
.get "https://tools.usps.com/zip-code-lookup.htm?byaddress"
Set dropdown = .FindElementById("tState")
'other code
If TextIsSet(dropdown, expectedText, MAX_WAIT_SEC) Then
Debug.Print "Tada"
Else
Debug.Print "Sigh"
End If
.Quit
End With
End Sub
Public Function TextIsSet(ByRef dropdown As Object, ByVal expectedText As String, ByVal MAX_WAIT_SEC As Long) As Boolean
Dim t As Date
On Error Resume Next
t = Timer
Do
DoEvents
dropdown.AsSelect.SelectByText expectedText
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop Until dropdown.AsSelect.SelectedOption.Text = expectedText
If dropdown.AsSelect.SelectedOption.Text = expectedText Then
TextIsSet = True
Else
TextIsSet = False
End If
On Error GoTo 0
End Function

Related

How can I choose option from this dropdown menu on this website

I am working in vba and trying fill in the form in this website and get the output Link Here
There is a problem when i try to fill in the input box from/to airport. This is what i have tried: This function is being called to fill in from/to airport fields
Function enter_get_name(ByVal iedoc As HTMLDocument, _
ByVal input_box As String, ByVal iata As String, _
ByVal id As String, ByRef str As Variant) As Boolean
Dim noopt As Integer ' length of string that appear on drop down menu if no option available
noopt = Len("If your destination does not appear among the cities listed in the destination box")
iedoc.getElementsByName(input_box)(0).innerText = iata ' enter string
Set drop_down = iedoc.getElementById(id).getElementsByTagName("li")
Do While drop_down.Length = 0: DoEvents: Loop ' wait for the drop down menu to come up
If Len(drop_down(0).innerText) = noopt Then ' if option do not exist
enter_get_name = False ' return value
Exit Function ' exit
Else
For Each Name In drop_down ' loop all options of drop down menu
' if found a exact same IATA code, click that html element
str = Mid(Name.innerText, Len(Name.innerText) - 4, 3)
If StrComp(iata, str, 1) = 0 Then
Name.Click
Exit For
End If
Next
enter_get_name = True
End If
End Function
So I have tried to loop all options available in the dropdown, find that element, then click it. The code can find the element successfully, but when i try to .click that element, it does not work sometimes. For example, i have a flight From HKG To SIN as input.
There is 2 options for the arrival(TO) airport: HEL and SIN, it somehow clicked HEL. However, if i do it the other way around, ie: From SIN to HKG, there is no problem with selecting SIN with 10+ options available. How can i resolve this? Any help would be appreciated.
The following uses regex to search the suggested list for the right entry and then click. I'd like to knock out some of the admittedly short hardcoded delays but haven't yet seen a reliable way to ensure dropdown list is fully populated , given it is continuously populated from ajax calls, without such measures.
Public Sub GetInfo()
Dim d As WebDriver, i As Long, t As Date
Const MAX_WAIT_SEC As Long = 10
Const Url = "https://applications.icao.int/icec"
Const FROM As String = "HKG"
Const GOING_TO As String = "SIN"
Dim re As Object
Set d = New ChromeDriver
Set re = CreateObject("vbscript.regexp")
With d
.Start "Chrome"
.get Url
.FindElementByCss("[name=frm1]").SendKeys FROM
Application.Wait Now + TimeSerial(0, 0, 1)
Dim fromSelection As Object
t = Timer
Do
Set fromSelection = .FindElementsByCss("#ui-id-1 li")
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While fromSelection.Count = 0
If .FindElementsByCss("#ui-id-1 li").Count = 0 Then Exit Sub
If .FindElementsByCss("#ui-id-1 li").Count = 1 Then
.FindElementsByCss("#ui-id-1 li").item(1).Click
Else
On Error Resume Next
For i = 1 To .FindElementsByCss("#ui-id-1 li").Count
If MatchFound(re, .FindElementsByCss("#ui-id-1 li").item(i).Text, "\(" & FROM & "[ \t]\)") Then
.FindElementsByCss("#ui-id-1 li").item(i).Click
Exit For
End If
Next
On Error GoTo 0
End If
.FindElementByCss("[name=to1]").SendKeys GOING_TO
Application.Wait Now + TimeSerial(0, 0, 1)
Dim toSelection As Object
t = Timer
Do
Set toSelection = .FindElementsByCss("#ui-id-2 li")
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While toSelection.Count = 0
If .FindElementsByCss("#ui-id-2 li").Count = 0 Then Exit Sub
If .FindElementsByCss("#ui-id-2 li").Count = 1 Then
.FindElementsByCss("#ui-id-2 li").item(1).Click
Else
On Error Resume Next
For i = 1 To .FindElementsByCss("#ui-id-2 li").Count
If MatchFound(re, .FindElementsByCss("#ui-id-2 li").item(i).Text, "\(" & GOING_TO & "[ \t]\)") Then
.FindElementsByCss("#ui-id-2 li").item(i).Click
Exit For
End If
Next
On Error GoTo 0
End If
Application.Wait Now + TimeSerial(0, 0, 1)
.FindElementById("computeByInput").Click
Stop 'delete me later
.Quit
End With
End Sub
Public Function MatchFound(ByVal re As Object, ByVal inputString As String, ByVal pattern As String) As Boolean
With re
.Global = True
.MultiLine = True
.IgnoreCase = True
.pattern = pattern
If .test(inputString) Then
MatchFound = True
Exit Function
End If
End With
MatchFound = "False"
End Function

Method 'Text' of object 'ISapCTextField' failed

I have to pull data from SAP. This error happens randomly:
Method 'Text' of object 'ISapCTextField' failed
I searched but none of the solutions work. Error handling by trying multiple times also didn't work. Instead of trying more methods, I avoided the .Text method altogether.
Example of line causing the error:
session.findById("wnd[0]/usr/ctxtMATNR-LOW").text = "500000000"
To avoid using the .text method, I used SendKeys to achieve the same thing. Basically making the SAP window as active window and selecting the desired field in SAP GUI by using set focus, and then using Ctrl+V via sendkeys to paste the text from a range to the field. Below is the code:
'Declaration
Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Declare Function SetForegroundWindow Lib "user32" ( _
ByVal HWnd As Long) As Long
'Finds SAP Window.
Public Sub ActivateSAPWindow()
Dim HWnd As Long
'SAP window Name can be found on the status bar of the Portal.
'Note: This only works in when you click on R/3 and it open a portal. It will not work if it open in the internet explorer
'To make it work for internet explorer , Simply change the name of the Window to find internet explorer or any window you wish.
HWnd = FindWindow(vbNullString, "R/3 - SAP NetWeaver Portal - Internet Explorer")
If HWnd Then
SetForegroundWindow HWnd
End If
End Sub
Public Sub SAPSafeText(ID As String, OriginCell As String)
'Location of the cell you wanna copy to the field.
Worksheets("SAP Mapping").Range(OriginCell).Copy
Call ActivateSAPWindow
Session.FindByID(ID).SetFocus
SendKeys "^v"
'Important to wait for completion before next line.
Wait (5)
End Sub
To call the function , Simply use SAP script record to get the Field ID name and parse into the SAPSafeText("ID of the Field as string", "Cell Range as string").
Example of call:
Call SAPSafeText("wnd[0]/usr/ctxtBWART-LOW", Low)
Call SAPSafeText("wnd[0]/usr/ctxtBWART-HIGH", High)
This is the brute force way but it works.
Why is the error happening?
Is there a better way to handle this?
I met the same situation too. I solve it. I think that is you use the sentence like
session.findbyid (*****).text = cells(i,j)
you should try to use
session.findbyid (*****).text = cells(i,j).value
You could try the following instead of sendkeys method:
...
Application.Wait (Now + TimeValue("0:00:01"))
session.findById("wnd[0]/usr/ctxtMATNR-LOW").text = "500000000"
...
Regards,
ScriptMan
below are snips of the code that could cause the random error. There are about 7 other Reports. Here is the MRP report example.
Public SapGuiAuto As Object
Public SAPApp As SAPFEWSELib.GuiApplication
Public SAPConnection As SAPFEWSELib.GuiConnection
Public Session As SAPFEWSELib.GuiSession
Sub InitSession()
On Error GoTo InternetAutomation
ErrorCounter = ErrorCounter + 1
Set SapGuiAuto = GetObject("SAPGUI")
If Not IsObject(SapGuiAuto) Then
Exit Sub
End If
Set SAPApp = SapGuiAuto.GetScriptingEngine()
If Not IsObject(SAPApp) Then
Exit Sub
End If
Set SAPConnection = SAPApp.Connections(0)
If Not IsObject(SAPConnection) Then
Exit Sub
End If
Set Session = SAPConnection.Sessions(0)
If Not IsObject(Session) Then
Exit Sub
End If
Exit Sub
InternetAutomation:
.........
End sub
sub MRP()
Call InitSession
Call TCodeBox("/n/DS1/APO_C_")
Call PlantCode_MRP("A11")
Call Material_MRP("E3")
Call SetPath_MRP
Call Execute
Call MRPReportProcess
End Sub
Sub PlantCode_MRP(Cell As String)
session.findById("wnd[0]/usr/ctxtS_WERKS-LOW").Text = Range(Cell)
session.findById("wnd[0]/usr/btn%_S_WERKS_%_APP_%-VALU_PUSH").press
Call SAPMultiSelect(Cell)
End Sub
Sub Material_MRP(Cell As String)
Worksheets("MB52 Total").Activate
session.findById("wnd[0]/usr/btn%_S_MATNR_%_APP_%-VALU_PUSH").press
Call SAPMultiSelect(Cell)
End Sub
Sub SetPath_MRP()
session.findById("wnd[0]/usr/ctxtP_PATH").Text = Desktop
session.findById("wnd[0]/usr/txtP_NAME").Text = MRPFileName
End Sub
Sub TCodeBox(TCode As String)
session.findById("wnd[0]/tbar[0]/okcd").Text = TCode
On Error GoTo TCodeErrorHandler
session.findById("wnd[0]").sendVKey 0
TCodeErrorHandler:
session.findById("wnd[0]/tbar[0]/btn[15]").press
session.findById("wnd[0]/tbar[0]/okcd").Text = TCode
session.findById("wnd[0]").sendVKey 0
Resume Next
Exit Sub 'Enter
End Sub
Sub Execute()
session.findById("wnd[0]/tbar[1]/btn[8]").press
End Sub
Regards,Jacob.
Sometimes I could solve similar errors by restarting the transaction.
for example:
Sub PlantCode_MRP(Cell As String)
on error resume next
session.findById("wnd[0]/usr/ctxtS_WERKS-LOW").Text = Range(Cell)
if err.number <> 0 then
Call TCodeBox("/n/DS1/APO_C_")
session.findById("wnd[0]/usr/ctxtS_WERKS-LOW").Text = Range(Cell)
end if
on error goto 0
'On Error GoTo InternetAutomation
session.findById("wnd[0]/usr/btn%_S_WERKS_%_APP_%-VALU_PUSH").press
Call SAPMultiSelect(Cell)
End Sub
Regards,
ScriptMan

Excel VBA check if named range is set

I'm trying to determine if a named range has been set via VBA. The named range is called LoadedToken and essentially is loaded when a user clicks a particular button. I use this as proof that initialisation has taken place.
I have a function to check if this has taken place:
Function ToolIsEnabled()
' We check if the R2A add-in has been loaded by detecting the named range
If ActiveWorkbook.Names("LoadedToken") Is Nothing Then
ToolIsEnabled = False
Else
ToolIsEnabled = True
End If
End Function
and I get an application error. Of course, the VBA is incorrect. However how can I actually accomplish this?!
Sub Test()
Debug.Print IsNamedRange("Bumsti")
End Sub
Function IsNamedRange(RName As String) As Boolean
Dim N As Name
IsNamedRange = False
For Each N In ActiveWorkbook.Names
If N.Name = RName Then
IsNamedRange = True
Exit For
End If
Next
End Function
Usage in OP context could be
' ...
If IsNamedRange("LoadedToken") Then
' ...
End If
' ...
or - if a program specific Bool needs to be set
' ...
Dim IsTokenLoaded as Boolean
IsTokenLoaded = IsNamedRange("LoadedToken")
' ...
Both constructs make it pretty clear in the source code what you are aiming for.
You can achieve this by using error handling:
Function ToolIsEnabled() As Boolean
Dim rng As Range
On Error Resume Next
Set rng = ActiveWorkbook.Range("LoadedToken")
On Error GoTo 0
ToolIsEnabled = Not rng is Nothing
End Function
This will check either in ThisWorkbook or a named workbook and return TRUE/FALSE.
Sub Test()
MsgBox NamedRangeExists("SomeName")
MsgBox NamedRangeExists("SomeOtherName", Workbooks("Book1.xls"))
End Sub
Public Function NamedRangeExists(sName As String, Optional Book As Workbook) As Boolean
On Error Resume Next
If Book Is Nothing Then
Set Book = ThisWorkbook
End If
NamedRangeExists = Book.Names(sName).Index <> (Err.Number = 0)
On Error GoTo 0
End Function
Edit:
A shorter version if it's only going to look in ThisWorkbook:
Public Function NamedRangeExists(sName As String) As Boolean
On Error Resume Next
NamedRangeExists = ThisWorkbook.Names(sName).Index <> (Err.Number = 0)
On Error GoTo 0
End Function
For the activeworkbook, you could also call the old XLM NAMES() function:
Function IsNameInActiveWorkbook(sName As String) As Boolean
IsNameInActiveWorkbook = Not IsError(Application.ExecuteExcel4Macro("MATCH(""" & sName & """,NAMES(),0)"))
End Function
As per Tom's answer these 2 line should do the trick:
On Error Resume Next
Set TestRange = ActiveWorkbook.Range("LoadedToken") 'if it does **not** exist this line will be ERROR

How to edit cells in excel while vba script is running continously

Option Explicit
Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Dim status As String
Sub StartModule()
Dim index As Integer
Dim result As String
Dim o: Set o = CreateObject("NAddIn.Functions")
status = ""
Do Until status = "DADA"
result = o.getRandomNumber
Range("F2").Value = result
Sleep123
If status = "EXIT" Then Exit Do
Loop
End Sub
Sub StopModule()
status = "EXIT"
End Sub
Sub Sleep123()
Sleep 1000 'Implements a 1 second delay
End Sub
This vba script is calling called getRandomNumber() which is a user defined function in dll file. After running by clicking start button, I am able to run the function which continuously generates a random number and shows in a cell .
The problem is I'm unable to click stop button or edit any cell and even I cannot close the xl file.
Don't use the Sleep API. The Sleep function not only suspends the execution of the current thread for a specified interval but also will not let you do anything else. i.e it will freeze Excel. Use this custom function Wait that I created many years ago.
Option Explicit
Dim status As String
Sub StartModule()
Dim index As Integer
Dim result As String
Dim o: Set o = CreateObject("NAddIn.Functions")
status = ""
Do Until status = "DADA"
result = o.getRandomNumber
Range("F2").Value = result
Wait 1 '<~~ Wait for a second
If status = "EXIT" Then Exit Do
Loop
End Sub
Sub StopModule()
status = "EXIT"
End Sub
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
BTW, it's not a good idea editing cells when you have set a timer to 1 second. When you are in the edit mode, you will get an error as Excel will not be able to write to cell F2. Consider increasing the timer in such a case :)

check if array is empty (vba excel)

These if ... then statements are getting the wrong results in my opinion. The first is returning the value 'false' when it should be 'true'. The fourth returns the right value. The second and third return an error.
Sub empty_array()
Dim arr1() As Variant
If IsEmpty(arr1) Then
MsgBox "hey"
End If
If IsError(UBound(arr1)) Then
MsgBox "hey"
End If
If IsError(Application.match("*", (arr1), 0)) Then
MsgBox "hey"
End If
ReDim arr1(1)
arr1(1) = "hey"
If IsEmpty(arr1) Then
MsgBox "hey"
End If
End Sub
Arr1 becomes an array of 'Variant' by the first statement of your code:
Dim arr1() As Variant
Array of size zero is not empty, as like an empty box exists in real world.
If you define a variable of 'Variant', that will be empty when it is created.
Following code will display "Empty".
Dim a as Variant
If IsEmpty(a) then
MsgBox("Empty")
Else
MsgBox("Not Empty")
End If
Adding into this: it depends on what your array is defined as. Consider:
dim a() as integer
dim b() as string
dim c() as variant
'these doesn't work
if isempty(a) then msgbox "integer arrays can be empty"
if isempty(b) then msgbox "string arrays can be empty"
'this is because isempty can only be tested on classes which have an .empty property
'this do work
if isempty(c) then msgbox "variants can be empty"
So, what can we do? In VBA, we can see if we can trigger an error and somehow handle it, for example
dim a() as integer
dim bEmpty as boolean
bempty=false
on error resume next
bempty=not isnumeric(ubound(a))
on error goto 0
But this is really clumsy... A nicer solution is to declare a boolean variable (a public or module level is best). When the array is first initialised, then set this variable.
Because it's a variable declared at the same time, if it loses it's value, then you know that you need to reinitialise your array.
However, if it is initialised, then all you're doing is checking the value of a boolean, which is low cost. It depends on whether being low cost matters, and if you're going to be needing to check it often.
option explicit
'declared at module level
dim a() as integer
dim aInitialised as boolean
sub DoSomethingWithA()
if not aInitialised then InitialiseA
'you can now proceed confident that a() is intialised
end sub
sub InitialiseA()
'insert code to do whatever is required to initialise A
'e.g.
redim a(10)
a(1)=123
'...
aInitialised=true
end sub
The last thing you can do is create a function; which in this case will need to be dependent on the clumsy on error method.
function isInitialised(byref a() as variant) as boolean
isInitialised=false
on error resume next
isinitialised=isnumeric(ubound(a))
end function
#jeminar has the best solution above.
I cleaned it up a bit though.
I recommend adding this to a FunctionsArray module
isInitialised=false is not needed because Booleans are false when created
On Error GoTo 0 wrap and indent code inside error blocks similar to with blocks for visibility. these methods should be avoided as much as possible but ... VBA ...
Function isInitialised(ByRef a() As Variant) As Boolean
On Error Resume Next
isInitialised = IsNumeric(UBound(a))
On Error GoTo 0
End Function
I would do this as
if isnumeric(ubound(a)) = False then msgbox "a is empty!"
I may be a bit late, but following simple stuff works with string arrays:
Dim files() As String
files = "..." 'assign array
If Not Not files Then
For i = LBound(files) To UBound(files)
'do stuff, array is not empty
Next
End If
That's all the code for this.
Above methods didn´t work for me. This did:
Dim arrayIsNothing As Boolean
On Error Resume Next
arrayIsNothing = IsNumeric(UBound(YOUR_ARRAY)) And False
If Err.Number <> 0 Then arrayIsNothing = True
Err.Clear
On Error GoTo 0
'Now you can test:
if arrayIsNothing then ...
this worked for me:
Private Function arrIsEmpty(arr as variant)
On Error Resume Next
arrIsEmpty = False
arrIsEmpty = IsNumeric(UBound(arr))
End Function
The problem with VBA is that there are both dynamic and static arrays...
Dynamic Array Example
Dim myDynamicArray() as Variant
Static Array Example
Dim myStaticArray(10) as Variant
Dim myOtherStaticArray(0 To 10) as Variant
Using error handling to check if the array is empty works for a Dynamic Array, but a static array is by definition not empty, there are entries in the array, even if all those entries are empty.
So for clarity's sake, I named my function "IsZeroLengthArray".
Public Function IsZeroLengthArray(ByRef subject() As Variant) As Boolean
'Tell VBA to proceed if there is an error to the next line.
On Error Resume Next
Dim UpperBound As Integer
Dim ErrorNumber As Long
Dim ErrorDescription As String
Dim ErrorSource As String
'If the array is empty this will throw an error because a zero-length
'array has no UpperBound (or LowerBound).
'This only works for dynamic arrays. If this was a static array there
'would be both an upper and lower bound.
UpperBound = UBound(subject)
'Store the Error Number and then clear the Error object
'because we want VBA to treat unintended errors normally
ErrorNumber = Err.Number
ErrorDescription = Err.Description
ErrorSource = Err.Source
Err.Clear
On Error GoTo 0
'Check the Error Object to see if we have a "subscript out of range" error.
'If we do (the number is 9) then we can assume that the array is zero-length.
If ErrorNumber = 9 Then
IsZeroLengthArray = True
'If the Error number is something else then 9 we want to raise
'that error again...
ElseIf ErrorNumber <> 0 Then
Err.Raise ErrorNumber, ErrorSource, ErrorDescription
'If the Error number is 0 then we have no error and can assume that the
'array is not of zero-length
ElseIf ErrorNumber = 0 Then
IsZeroLengthArray = False
End If
End Function
I hope that this helps others as it helped me.
I'm using this
If UBound(a) >= 0 Then
' not empty
Else
' empty... UBound(a) = -1
End If
IsEmpty(a) did not work for me... I hate VBA
Dim arr() As Variant
Debug.Print IsEmpty(arr) ' False
Debug.Print UBound(arr) ' raises error
arr = Array()
Debug.Print IsEmpty(arr) ' False
Debug.Print UBound(arr) ' -1
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = "test"
Debug.Print IsEmpty(arr) ' False
Debug.Print UBound(arr) ' 0
The below function works for both static and dynamic arrays.
Function array_Empty(testArr As Variant) As Boolean
Dim i As Long, k As Long, flag As Long
On Error Resume Next
i = UBound(testArr)
If Err.Number = 0 Then
flag = 0
For k = LBound(testArr) To UBound(testArr)
If IsEmpty(testArr(k)) = False Then
flag = 1
array_Empty = False
Exit For
End If
Next k
If flag = 0 Then array_Empty = True
Else
array_Empty = True
End If
End Function
Tente isso:
Function inic(mtz As Variant) As Boolean
On Error Resume Next
Dim x As Boolean
x = UBound(mtz): inic = x
End Function
...
if inic(mymtz) then
debug.print "iniciada"
else
debug.print "não iniciada"
end if

Resources