I don't understand why the code bellow is executed when the value of
strArray(0) is Subscript out of range. My booleanVariable changes to true and I don't want that.
If Left(strArray(0), 3) = "Usu" Then
booleanVariable = True
End If
Make sure the array(0) is not empty before trying to do string manipulation
sub t
If Initialized(strArray) Then ' is array setup
If strArray(0) <> "" Then ' if array has value
If Left(strArray(0), 3) = "Usu" Then
booleanVariable = True
End If
Else
MsgBox "No value in array"
End If
Else
MsgBox "Array not setup"
End If
end sub
Function Initialized(val) As Boolean
On Error GoTo errHandler
Dim i
If Not IsArray(val) Then GoTo exitRoutine
i = UBound(val)
Initialized = True
exitRoutine:
Exit Function
errHandler:
Select Case Err.Number
Case 9 'Subscript out of range
GoTo exitRoutine
Case Else
Debug.Print Err.Number & ": " & Err.Description, _
"Error in Initialized()"
End Select
Debug.Assert False
Resume
End Function
Related
I'm using the following sub, but it works only if I put in the array the string i want to use ( wat )
If I try to put in the array the cell where this string is (BZ6) the macro does not work.
In BZ6 I have =Sheet1!B8
In Sheet1B8 I have wat
Where is my mistake here?
Option Explicit
Sub SearchForString()
Dim a As Long, arr As Variant, fnd As Range, cpy As Range, addr As String
On Error GoTo Err_Execute
'populate the array for the outer loop
arr = Array("*" & "("BZ6")" & "*")
With Worksheets("Sheet8")
'outer loop through the array
For a = LBound(arr) To UBound(arr)
'locate first instance
Set fnd = .Columns("BT").Find(what:=arr(a), LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not fnd Is Nothing Then
'record address of first find
addr = fnd.Address
'seed the cpy range object
If cpy Is Nothing Then Set cpy = fnd.EntireRow
Do
'build union
Set cpy = Union(cpy, fnd.EntireRow)
'look for another
Set fnd = .Columns("BT").FindNext(after:=fnd)
'keep finding new matches until it loops back to the first
Loop Until fnd.Address = addr
End If
Next a
End With
With Worksheets("sheet2")
'one stop copy & paste operation
cpy.Copy Destination:=.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "All matching data has been copied."
Debug.Print Now & " " & Err.Number & " - " & Err.Description
End Sub
In general I have a good macro for change management for a single value and now can write one for an multi dimensional array but need to be able to differential between without the use of error handling.
Is there any other work around for when the target is only one cell? the error handling below handles the issue but I consider it to be "sloppy."
Suggestions are appreciated on a better method.
Sub Dims(target As Variant)
Dim varData As Variant
Dim i As Integer
Dim j As Integer
varData = target
On Error GoTo Err
For i = 1 To UBound(varData, 1)
For j = 1 To UBound(varData, 2)
Debug.Print i, j, varData(i, j)
Next j
Next i
Err:
If Err.Number = 13 Then
Debug.Print target.Value
ElseIf Err.Number <> 0 Then
MsgBox "Error " & Err.Number & " just occured."
ElseIf Err.Number <> 13 And Err.Number <> 0 Then
Debug.Print "Err No.= "; Err.Number
Else
Debug.Print "No Error"
End If
End Sub
I set up a if then statement to run one way if target.count =1 and another if target.count>1
I have an array that is populated if a formula produces an "X" in a cell that is part of a range:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Fault(10) As Boolean
For i = 1 To 10
If Range("A" & i).Value = "X" Then
Fault(i) = True
End If
Next i
MsgBox Fault 'VBA Errors Here With "Type Mismatch"
End Sub
My question is, is it possible to return an entire array as a string. So in the above example, I want the message box to return "0000000000" if there were no faults. If there was a fault in the 7th array, then it would return "0000001000".
My aim is to check that the string is always equal to "0000000000" in order to proceed. However, if there's a better way of checking if the entire array is false then that would be much easier.
Try this:
Sub JoinArray()
Dim Fault(9) As String, arrString As String
For i = 1 To 10
If Range("A" & i) = "X" Then
Fault(i - 1) = 1
Else
Fault(i - 1) = 0
End If
Next i
arrString = Join(Fault(), "")
If InStr(arrString, "1") Then
MsgBox "Fault Found"
Else
MsgBox "No faults found"
End If
End Sub
Notes:
Typically an array is zero indexed so Fault(9) allows for 10 slots e.g. Range("A1:A10")
The "" argument of Join means there are no space in the output i.e. 0011000000
Alternative method without using an array
Sub FindFaults()
Dim rng As Range, cl As Range, faultLocations As String
Set rng = Range("A1:A1000")
faultLocations = "Faults found in the following cell(s):" & vbCrLf & vbCrLf
If WorksheetFunction.CountIf(rng, "X") = 0 Then
MsgBox "No Fault Found"
Else
For Each cl In rng
If cl = "X" Then
faultLocations = faultLocations + "Cell: " & cl.Address & vbCrLf
End If
Next cl
End If
MsgBox faultLocations
End Sub
I need search in array
Sub f()
Dim myArray As Variant
myArray = Worksheets("QQ").Range("D:F")
Dim searchTerm As String
searchTerm = "927614*"
'Check if a value exists in the Array
If UBound(Filter(myArray, searchTerm)) >= 0 And searchTerm <> "" Then
MsgBox "Your string match value from F column is " & myArray(Application.Match(searchTerm, myArray, False),3)
Else
MsgBox ("Search Term could NOT be located in the Array")
End If
End Sub
But I get error Type mismatch. So how to lookup value with * in array?
Just loop through the array and use Like.
Untested code:
Dim matchFound As Boolean
matchFound = False
For i = 1 To UBound(myArray, 1)
For j = 1 To UBound(myArray, 2)
If myArray(i, j) Like searchTerm Then
MsgBox "Found match at (" & i & "," & j & ") : " & myArray(i, j)
matchFound = True
Exit For
End If
Next j
If matchFound Then Exit For
Next i
If Not matchFound Then MsgBox "No match found."
If I declare a dynamic sized array like this
Dim myArray()
Then how I can get in the code if this array is empty or it contains elements?
I tried with IsArray(myArray) function that give me always True,
otherwise if I try with UBound(myArray) function, I get an error.
Any ideas? thanks in advance,
Max
After declaring the array, you have to initialize it:
Dim myArray()
ReDim myArray(-1)
Then such code will always work:
If UBound(myArray)<0 Then
'array is empty....
Else
'array not empty....
End If
Edit: as you can't initialize the array, here is longer way to check if it's empty or not:
Dim x, myCount
myCount = 0
If IsArray(myArray) Then
For Each x In myArray
myCount = myCount + 1
Next
End If
If myCount=0 Then
'array is empty....
Else
'array not empty....
End If
First some notes.
Using Dim A() is not so practical in VBScript, better use ReDim
A(n).
For example ReDim A(-1) is also empty array (no elements) but initialized.
And as the best way coders to talk is by examples...
Dim a(), b(0), c
c = Array(a, b)
ReDim d(-1)
WScript.Echo "Testing HasBound:"
WScript.Echo "a = " & HasBound(a) & ",", _
"b = " & HasBound(b) & ",", _
"c = " & HasBound(c) & ",", _
"d = " & HasBound(d)
WScript.Echo "Testing HasItems:"
WScript.Echo "a = " & HasItems(a) & ",", _
"b = " & HasItems(b) & ",", _
"c = " & HasItems(c) & ",", _
"d = " & HasItems(d)
'> Testing HasBound:
'> a = False, b = True, c = True, d = True
'> Testing HasItems:
'> a = False, b = True, c = True, d = False
Function HasBound(anyArray)
On Error Resume Next
HasBound = UBound(anyArray)
HasBound = (0 = Err)
On Error Goto 0
End Function
Function HasItems(anyArray)
For Each HasItems In anyArray
HasItems = 1
Exit For
Next
HasItems = (HasItems > 0)
End Function
As you see, 2 functions with different purpose. The difference is visible on array d which "has-boundary" but "has-not-items".
I found a solution, I wrote a specific function to check if an array is null or not; the function doesn't check if it has elements inside but only if the array is declared as dynamic without dimensions and no elements.
Dim dynamic_array() 'array without a dimension
Dim empty_array(0) 'array with a dimension but without an element inside
Dim full_array(0) : full_array(0) = "max" 'array with a dimension and with an element inside
Function IsNullArray(input_array)
On Error Resume Next
Dim is_null : is_null = UBound(input_array)
If Err.Number = 0 Then
is_null = False
Else
is_null = True
End If
IsNullArray = is_null
End Function
If IsNullArray(dynamic_array) Then
Response.Write("<p>dynamic array not 'ReDimed'</p>")
End If
If Not IsNullArray(empty_array) Then
Response.Write("<p>" & UBound(empty_array) & "</p>") 'return the last index of the array
End If
If Not IsNullArray(full_array) Then
Response.Write("<p>" & full_array(UBound(full_array)) & "</p>") 'return the value of the last element of the array
End If
The one thing I can think of right now is:
On Error resume next
if UBound(myArray) < 0 then response.write "Empty array" end if
EDIT: Max's comment
I've always checked for UBound = 0 and the first element is empty too:
If UBound(myArray) = 0 Then
if myArray(0) = "" then ''Depending on the type of the array
''array is empty....
End If
End If