In userform1, I have the following code
Private Sub cmdOK_Click()
Dim i As Long
With Me.ListBox2
If .ListCount = 0 Then MsgBox "You Have To Select At Least One Column", vbExclamation: GoTo Skipper
ReDim aCols(0 To .ListCount - 1)
For i = 0 To .ListCount - 1
aCols(i) = "[" & ListBox2.List(i, 0) & "]"
Next i
End With
Skipper:
Unload Me
End Sub
and in standard module I declared aCols as public
Public aCols
if listbox2 has no items then aCols became Empty while if there are items the aCols became an array ..
Then in another code I am confused of how to avoid errors
If UBound(aCols) > -1 Then
This works fine if aCols is not empty but I encountered errors if aCols is Empty .. How to deal with both cases
Simply I need to avoid the errors and deal with aCols either it is empty or either it is an array.
I would use Function safeUBound() which looks ugly due to OERN but works fine:
Function safeUBound(a)
safeUBound = -1
On Error Resume Next
safeUBound = UBound(a)
End Function
Another solution is to assign empty array or empty 2d array to the variable aCols either at the very beginning of the code or at userform initialize.
Related
I'm trying to edit some objects texts with this:
' Textbox1
' Textbox2
' Textbox3
Sub Change_Text()
Dim i As Integer
For i = 1 To 3
UserForm1.Textbox & i = "Hi"
Next i
End Sub
I think the code explain my problem, of course it's returning an error, I don't have idea what to do...
You could do it like that
For i = 1 To 3
Controls("Textbox" & i) = "Hi"
Next i
Probably the optimal solution (least from your example) would be to loop over all the Textboxes
Private Sub loop_through_conts()
Dim cont as Control
For Each cont in Me.Controls
If TypeName(cont) = "Textbox" Then
Select Case Right(cont.Name, 1) ' in case you want only first three
Case 1 To 3
cont.Text = "Hi"
End Select
End If
Next cont
End Sub
This way your code is dynamic and does not have to be re-written in case a new Textbox were to be added
I've got an UserForm, which upon an incorrect user input calls the following procedure, which highlights the field and disables the "save changes" button.
Private disabledElems As New Collection
Private Sub disable(ByRef controlName As String)
UserForm1.Controls(controlName).BackColor = &H8080FF
Me.save_button.Enabled = False
Dim i As Byte
If disabledElems.Count <> 0 Then
For i = 1 To disabledElems.Count
If disabledElems(i) = controlName Then
Exit Sub ' we dont want to add duplicates to collection
End If
Next i
End If
disabledElems.Add controlName ' otherwise add to collection
End Sub
If the input is corrected, it calls the enable procedure, which looks like this:
Private Sub enable(ByRef controlName As String)
Me.Controls(controlName).BackColor = &H80000005
Dim i As Byte
For i = 1 To disabledElems.Count
If disabledElems(i) = controlName Then
disabledElems.Remove i ' remove the enabled element upon match
End If
Next i
If disabledElems.Count = 0 Then
save_button.Enabled = True
End If
End Sub
This seems to work just fine when I try this with one Textbox
However, as soon I have multiple incorrect entries, my enable procedure seems to throw a Subscript out of range error seemingly for no reason.
The highlighted line in the debugger is:
If disabledElems(i) = controlName Then
I can't comprehend what could be causing this. Any ideas?
Ah alright, it's one of those classical "when removing a row, loop
from end to beginning"
Basically, the reason why the Subscript out of range was thrown - once the element was removed from the collection via the
disabledElems.Remove i
It reduced the size of the Collection from Collection.Count to Collection.Count - 1, however during the for loop declaration, the i was already hard-set to the previous Collection.Count
In an practical example:
Let's say my Collection looks like this
disabledElems = "button1", "button2"
Upon doing this
controlName = "button1"
For i = 1 to disabledElems.Count ' <= 2
If disabledElems(i) = controlName ' < True for i = 1
disabledElems.Remove i ' < button1 was removed from collection, however it still loops
End If
' will loop to i = 2. However disabledElems(2) no longer exists, because upon removal _
the button2 was shifted to disabledElems(1) - hence Subscript out of range
Next i
A clear case of trying to access an element, which has shifted its position in the queue.
There are two possible fixes (that I can think of):
1. Enforce Exit Sub upon removal
For i = 1 to disabledElems.Count
If disabledElems(i) = controlName
disabledElems.Remove i
Exit Sub
End If
Next i
2. Loop from end to start
Dim i as Integer ' needs to be redeclared to int, because Byte can't -1
For i = disabledElems.Count to 1 Step -1
If disabledElems(i) = controlName
disabledElems.Remove i
End If
Next i
I have just started using dictionaries and Class collections. I wrote a code using both that worked fine (see code below).
For a = 2 To UBound(FullArray, 1)
Set GEMclass = dict.Items(a) '<-------
GEM = GEMclass.g
'Do while loop
Do
'Check to see if Parent has an owner
If (Not (dict.Exists(GEM))) Then
Nrow = 0
Else
Nrow = dict(GEM).Num
Call Main
Call PartTwo
Call PartThree
End If
Loop Until (Nrow = 0) 'keep doing this unti no tree link
Next a
Call TurnOnFunctionality
End Sub
However, I tried to use the same line of code in another sub and it does not work (the line is in marked with an arrow).
Dim i As Integer
If ((GemDict.Exists(GEM))) Then
i = GemDict.Item(GEM)
i = i - 2
Set GEMclass = GemDict.Items(i) '<-------
'Debug.Print GemDict.Item(GEM)
'Debug.Print GemDict.Keys(i)
If GEMclass.NumofP > 1 Then
MsgBox "Greater 1"
Else
MsgBox "Only 1"
End If
End If
GEM = GEMclass.P
I declared both GEMclasses in each code as so
Public GEMclass As Gclass
Any ideas? I am stumped.
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
I have a variable "jobNo" which changes between 1 and 5 depending on user input. I have another 5 variable: "J1C", "J2C", "J3C" ...
How do I place the variable "jobNo" within the other 5 variables so that when jobNo=3 for example I will be able to say:
J3C = 0
I have tried:
"J" & jobNo & "C" = 0
but get errors. How would I do this please?
My suggestion is the same as what #simoco commented. Use an Array:
Dim JC(1 to 5) As Double
JC(1) = 0
JC(2) = 0
JC(3) = 0
JC(4) = 0
JC(5) = 0
You really should use arrays, not doing so, in this case, is very bad programming...
But if it is not possible to change everything you can create this:
Sub VBP(jobNo, J1C, J2C, J3C, J4C, J5C)
Select Case jobNo
Case 1
J1C = 0
Case 2
J2C = 0
Case 3
J3C = 0
Case 4
J4C = 0
Case 5
J5C = 0
End Select
End Sub
and then call it like this:
VBP jobNo, J1C, J2C, J3C, J4C, J5C
Mostly because I hate the vba Array you could use a Collection object
Dim jobNos As New Collection
Sub intializejobNos
With jobNos
.Add 0, "J1C"
.Add 0, "J2C"
.Add 0, "J3C"
.Add 0, "J4C"
.Add 0, "J5C"
End With
End Sub
Sub changeJobNo(jobNo As String, val AS Variant)
OnError GoTo Handler
With jobNos
.Remove jobNo
.Add val, jobNo
End With
Exit_changeJobNo:
Exit Sub
Handler:
Msgbox "Job Number " & jobNo & " Does not exist in the collection."
GoTo Exit_changeJobNo
End Sub
Sub addJobNo(jobNo As Integer, val AS Variant)
jobNos.Add val, "J" & jobNo & "C"
End Sub
This way you can intialize the jobNos Collection whic hwill have a completely variable size without the need to ReDim and then you can change the values where needed and you can then use dynamic functions like you want i.e.
Function getJobNo(jobNo AS Integer) As Variant
If jobNos.Count = 0 Then
initializejobNos
End If
getJobNo = jobNos("J" & jobNo & "C")
End Function
Obviously some additional Error Handling should be put in place but I find Collection objects far easier and more concise than using native VBA Arrays.