I have a function LastItem which returns the last word from the string. It works fine for strings with value but for blanks like "" it fails.
I am checking if Split returned an Array. Even for blank string the IsArray() returns true. Is there a way to Fix it.
Errors are mentioned as comment in the code.
Sub test()
Debug.Print LastItem("a b c")
Debug.Print LastItem("a")
Debug.Print LastItem("") '''' ===> Error for this one
End Sub
Public Function LastItem(source As String) As String
Dim arr
arr = Split(source, Space(1))
If IsArray(arr) Then
LastItem = arr(UBound(arr)) '''' ===> For LastItem("") error is [Subscript out of range]
Else
LastItem = source
End If
End Function
Check if upper bound is greater than -1
Public Function LastItem(source As String) As String
Dim arr
arr = Split(source, Space(1))
'/ Check if upper bound is greater than -1
If UBound(arr) > -1 Then
LastItem = arr(UBound(arr))
Else
LastItem = source
End If
End Function
Split always returns an array so an IsArray check is unnecessary.
How about this? Bail early if the input is a zero-length string.
Public Function LastItem(source As String) As String
If source = vbNullString Then Exit Function
Dim arr
arr = Split(source, Space(1))
LastItem = arr(UBound(arr))
End Function
I was hoping to receive help editing this helpful piece of code:
Function ListSearchB(text As String, wordlist As String, Optional caseSensitive As Boolean = False)
Dim strMatches As String
Dim res As Variant
Dim arrWords() As String
arrWords = Split(wordlist)
On Error Resume Next
Err.Clear
For Each word In arrWords
If caseSensitive = False Then
res = InStr(LCase(text), LCase(word))
Else
res = InStr(text, word)
End If
If res > 0 Then
strMatches = strMatches & word
End If
Next word
If Len(strMatches) <> 0 Then
strMatches = Right(strMatches, Len(strMatches))
End If
ListSearchB = strMatches
End Function
This code works excellent for what it does currently. First it selects the text string to compare, then selects the array of comma separated words its looking to find matches to. If any of the words in the text string match to a word in the array it will return that match.
What I'm looking to add to it is to be able to select the first cell with text, then a second cell with text, and then the array itself and return any and all matches from both selected cells that match.
I tried all day trying to get it to work but I've been getting errors each time.
example would look like:
A1: apples taste better than the oranges
B1: strawberries are the best berry
C1(array): apples, strawberries, blueberries, peaches, oranges
D1(output): apples oranges strawberries
Some functions to help you:
'To check if an element is within a specific Array, Object, Range, String, etc.
Public Function isInArray(ByVal itemSearched As Variant, ByVal aArray As Variant) As Boolean
Dim item As Variant
If VarType(aArray) >= vbArray Or VarType(aArray) = vbObject Or VarType(aArray) = vbDataObject Or TypeName(aArray) = "Range" Then
For Each item In aArray
If itemSearched = item Then
isInArray = True
Exit Function
End If
Next item
isInArray = False
ElseIf VarType(aArray) = vbString Then
isInArray = InStr(1, aArray, itemSearched, vbBinaryCompare) > 0 'Comparing character by character
Else
On Error Resume Next
isInArray = Not IsError(Application.Match(itemSearched, aArray, False)) 'Slow on large arrays
Err.Clear: On Error GoTo 0
End If
End Function
'To check if a word is within a sentence-like string
Public Function isInStrArray(ByVal itemSearched As Variant, ByVal strSource As Variant) As Boolean
Dim strArr As Variant
isInStrArray = False
If VarType(itemSearched) = vbString And VarType(strSource) = vbString Then
itemSearched = Trim(itemSearched): strSource = Trim(strSource)
If Len(itemSearched) > 0 And Len(strSource) > 0 Then
strArr = Split(strSource) 'Splitting at each space
isInStrArray = isInArray(itemSearched, strArr)
Erase strArr
End If
End If
End Function
I searched the website but was not succesfful and tried doing some research on this but facing with " Type Mismatch" error.
I declared an array as integer type but the FILTER function seems to work only with STRING's. Can you please let me know how I can use the FILTER function for integers?
If UBound(Filter(CntArr(), count)) > 0 Then
msgbox "found"
End If
as i understand you need to know if specified count present in array. You can use for loop for it:
Dim found as Boolean
found = False
For i = 0 To UBound (CntArr())
If CntArr(i) = count Then
found = True
Exit For
End If
Next i
If found Then msgbox "found" End If
Below I have created IsIntegerInArray() function that returns boolean. Follow the two Subs for an example of integer array declaration. Declaring array as Integer should also prevent some unnecessary bugs caused by implicit data conversion.
Sub test_int_array()
Dim a() As Integer
ReDim a(3)
a(0) = 2
a(1) = 15
a(2) = 16
a(3) = 8
''' expected result: 1 row for each integer in the array
Call test_printing_array(a)
End Sub
Sub test_printing_array(arr() As Integer)
Dim i As Integer
For i = 1 To 20
If IsIntegerInArray(i, arr) Then
Debug.Print i & " is in array."
End If
Next i
End Sub
Function IsIntegerInArray(integerToBeFound As Integer, arr() As Integer) As Boolean
Dim i As Integer
''' incorrect approach:
''' IsIntegerInArray = (UBound(Filter(arr, integerToBeFound)) > -1) ' this approach searches for string, e.g. it matches "1" in "12"
''' correct approach:
IsIntegerInArray = False
For i = LBound(arr) To UBound(arr)
If arr(i) = integerToBeFound Then
IsIntegerInArray = True
Exit Function
End If
Next i
End Function
I have string "ololo123".
I need get position of first digit - 1.
How to set mask of search ?
Here is a lightweight and fast method that avoids regex/reference additions, thus helping with overhead and transportability should that be an advantage.
Public Function GetNumLoc(xValue As String) As Integer
For GetNumLoc = 1 To Len(xValue)
If Mid(xValue, GetNumLoc, 1) Like "#" Then Exit Function
Next
GetNumLoc = 0
End Function
Something like this should do the trick for you:
Public Function GetPositionOfFirstNumericCharacter(ByVal s As String) As Integer
For i = 1 To Len(s)
Dim currentCharacter As String
currentCharacter = Mid(s, i, 1)
If IsNumeric(currentCharacter) = True Then
GetPositionOfFirstNumericCharacter = i
Exit Function
End If
Next i
End Function
You can then call it like this:
Dim iPosition as Integer
iPosition = GetPositionOfFirstNumericCharacter("ololo123")
Not sure on your environment, but this worked in Excel 2010
'Added reference for Microsoft VBScript Regular Expressions 5.5
Const myString As String = "ololo123"
Dim regex As New RegExp
Dim regmatch As MatchCollection
regex.Pattern = "\d"
Set regmatch = regex.Execute(myString)
MsgBox (regmatch.Item(0).FirstIndex) ' Outputs 5
I actually have that function:
Public Function GetNumericPosition(ByVal s As String) As Integer
Dim result As Integer
Dim i As Integer
Dim ii As Integer
result = -1
ii = Len(s)
For i = 1 To ii
If IsNumeric(Mid$(s, i, 1)) Then
result = i
Exit For
End If
Next
GetNumericPosition = result
End Function
You could try regex, and then you'd have two problems. My VBAfu is not up to snuff, but I'll give it a go:
Function FirstDigit(strData As String) As Integer
Dim RE As Object REMatches As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.Pattern = "[0-9]"
End With
Set REMatches = RE.Execute(strData)
FirstDigit = REMatches(0).FirstIndex
End Function
Then you just call it with FirstDigit("ololo123").
If speed is an issue, this will run a bit faster than Robs (noi Rob):
Public Sub Example()
Const myString As String = "ololo123"
Dim position As Long
position = GetFirstNumeric(myString)
If position > 0 Then
MsgBox "Found numeric at postion " & position & "."
Else
MsgBox "Numeric not found."
End If
End Sub
Public Function GetFirstNumeric(ByVal value As String) As Long
Dim i As Long
Dim bytValue() As Byte
Dim lngRtnVal As Long
bytValue = value
For i = 0 To UBound(bytValue) Step 2
Select Case bytValue(i)
Case vbKey0 To vbKey9
If bytValue(i + 1) = 0 Then
lngRtnVal = (i \ 2) + 1
Exit For
End If
End Select
Next
GetFirstNumeric = lngRtnVal
End Function
An improved version of spere's answer (can't edit his answer), which works for any pattern
Private Function GetNumLoc(textValue As String, pattern As String) As Integer
For GetNumLoc = 1 To (Len(textValue) - Len(pattern) + 1)
If Mid(textValue, GetNumLoc, Len(pattern)) Like pattern Then Exit Function
Next
GetNumLoc = 0
End Function
To get the pattern value you can use this:
Private Function GetTextByPattern(textValue As String, pattern As String) As String
Dim NumLoc As Integer
For NumLoc = 1 To (Len(textValue) - Len(pattern) + 1)
If Mid(textValue, NumLoc, Len(pattern)) Like pattern Then
GetTextByPattern = Mid(textValue, NumLoc, Len(pattern))
Exit Function
End If
Next
GetTextByPattern = ""
End Function
Example use:
dim bill as String
bill = "BILLNUMBER 2202/1132/1 PT2200136"
Debug.Print GetNumLoc(bill , "PT#######")
'Printed result:
'24
Debug.Print GetTextByPattern(bill , "PT#######")
'Printed result:
'PT2200136
This question already has answers here:
How do I determine if an array is initialized in VB6?
(24 answers)
Closed 3 years ago.
I want to check for empty arrays. Google gave me varied solutions but nothing worked. Maybe I am not applying them correctly.
Function GetBoiler(ByVal sFile As String) As String
'Email Signature
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.ReadAll
ts.Close
End Function
Dim FileNamesList As Variant, i As Integer
' activate the desired startfolder for the filesearch
FileNamesList = CreateFileList("*.*", False) ' Returns File names
' performs the filesearch, includes any subfolders
' present the result
' If there are Signatures then populate SigString
Range("A:A").ClearContents
For i = 1 To UBound(FileNamesList)
Cells(i + 1, 1).Formula = FileNamesList(i)
Next i
SigString = FileNamesList(3)
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
Here if FileNamesList array is empty, GetBoiler(SigString) should not get called at all. When FileNamesList array is empty, SigString is also empty and this calls GetBoiler() function with empty string. I get an error at line
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
since sFile is empty. Any way to avoid that?
Go with a triple negative:
If (Not Not FileNamesList) <> 0 Then
' Array has been initialized, so you're good to go.
Else
' Array has NOT been initialized
End If
Or just:
If (Not FileNamesList) = -1 Then
' Array has NOT been initialized
Else
' Array has been initialized, so you're good to go.
End If
In VB, for whatever reason, Not myArray returns the SafeArray pointer. For uninitialized arrays, this returns -1. You can Not this to XOR it with -1, thus returning zero, if you prefer.
(Not myArray) (Not Not myArray)
Uninitialized -1 0
Initialized -someBigNumber someOtherBigNumber
Source
As you are dealing with a string array, have you considered Join?
If Len(Join(FileNamesList)) > 0 Then
If you test on an array function it'll work for all bounds:
Function IsVarArrayEmpty(anArray As Variant)
Dim i As Integer
On Error Resume Next
i = UBound(anArray,1)
If Err.number = 0 Then
IsVarArrayEmpty = False
Else
IsVarArrayEmpty = True
End If
End Function
I see similar answers on here... but not mine...
This is how I am unfortunatley going to deal with it... I like the len(join(arr)) > 0 approach, but it wouldn't work if the array was an array of emptystrings...
Public Function arrayLength(arr As Variant) As Long
On Error GoTo handler
Dim lngLower As Long
Dim lngUpper As Long
lngLower = LBound(arr)
lngUpper = UBound(arr)
arrayLength = (lngUpper - lngLower) + 1
Exit Function
handler:
arrayLength = 0 'error occured. must be zero length
End Function
When writing VBA there is this sentence in my head: "Could be so easy, but..."
Here is what I adopted it to:
Private Function IsArrayEmpty(arr As Variant)
' This function returns true if array is empty
Dim l As Long
On Error Resume Next
l = Len(Join(arr))
If l = 0 Then
IsArrayEmpty = True
Else
IsArrayEmpty = False
End If
If Err.Number > 0 Then
IsArrayEmpty = True
End If
On Error GoTo 0
End Function
Private Sub IsArrayEmptyTest()
Dim a As Variant
a = Array()
Debug.Print "Array is Empty is " & IsArrayEmpty(a)
If IsArrayEmpty(a) = False Then
Debug.Print " " & Join(a)
End If
End Sub
This code doesn't do what you expect:
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
If you pass an empty string ("") or vbNullString to Dir, it will return the name of the first file in the current directory path (the path returned by CurDir$). So, if SigString is empty, your If condition will evaluate to True because Dir will return a non-empty string (the name of the first file in the current directory), and GetBoiler will be called. And if SigString is empty, the call to fso.GetFile will fail.
You should either change your condition to check that SigString isn't empty, or use the FileSystemObject.FileExists method instead of Dir for checking if the file exists. Dir is tricky to use precisely because it does things you might not expect it to do. Personally, I would use Scripting.FileSystemObject over Dir because there's no funny business (FileExists returns True if the file exists, and, well, False if it doesn't). What's more, FileExists expresses the intent of your code much clearly than Dir.
Method 1: Check that SigString is non-empty first
If SigString <> "" And Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
Method 2: Use the FileSystemObject.FileExists method
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(SigString) Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
I am simply pasting below the code by the great Chip Pearson. It works a charm.
Here's his page on array functions.
I hope this helps.
Public Function IsArrayEmpty(Arr As Variant) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsArrayEmpty
' This function tests whether the array is empty (unallocated). Returns TRUE or FALSE.
'
' The VBA IsArray function indicates whether a variable is an array, but it does not
' distinguish between allocated and unallocated arrays. It will return TRUE for both
' allocated and unallocated arrays. This function tests whether the array has actually
' been allocated.
'
' This function is really the reverse of IsArrayAllocated.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim LB As Long
Dim UB As Long
err.Clear
On Error Resume Next
If IsArray(Arr) = False Then
' we weren't passed an array, return True
IsArrayEmpty = True
End If
' Attempt to get the UBound of the array. If the array is
' unallocated, an error will occur.
UB = UBound(Arr, 1)
If (err.Number <> 0) Then
IsArrayEmpty = True
Else
''''''''''''''''''''''''''''''''''''''''''
' On rare occasion, under circumstances I
' cannot reliably replicate, Err.Number
' will be 0 for an unallocated, empty array.
' On these occasions, LBound is 0 and
' UBound is -1.
' To accommodate the weird behavior, test to
' see if LB > UB. If so, the array is not
' allocated.
''''''''''''''''''''''''''''''''''''''''''
err.Clear
LB = LBound(Arr)
If LB > UB Then
IsArrayEmpty = True
Else
IsArrayEmpty = False
End If
End If
End Function
Simplified check for Empty Array:
Dim exampleArray() As Variant 'Any Type
If ((Not Not exampleArray) = 0) Then
'Array is Empty
Else
'Array is Not Empty
End If
Here is another way to do it. I have used it in some cases and it's working.
Function IsArrayEmpty(arr As Variant) As Boolean
Dim index As Integer
index = -1
On Error Resume Next
index = UBound(arr)
On Error GoTo 0
If (index = -1) Then IsArrayEmpty = True Else IsArrayEmpty = False
End Function
Based on ahuth's answer;
Function AryLen(ary() As Variant, Optional idx_dim As Long = 1) As Long
If (Not ary) = -1 Then
AryLen = 0
Else
AryLen = UBound(ary, idx_dim) - LBound(ary, idx_dim) + 1
End If
End Function
Check for an empty array; is_empty = AryLen(some_array)=0
Public Function IsEmptyArray(InputArray As Variant) As Boolean
On Error GoTo ErrHandler:
IsEmptyArray = Not (UBound(InputArray) >= 0)
Exit Function
ErrHandler:
IsEmptyArray = True
End Function
You can use the below function to check if variant or string array is empty in vba
Function IsArrayAllocated(Arr As Variant) As Boolean
On Error Resume Next
IsArrayAllocated = IsArray(Arr) And _
Not IsError(LBound(Arr, 1)) And _
LBound(Arr, 1) <= UBound(Arr, 1)
End Function
Sample usage
Public Function test()
Dim Arr(1) As String
Arr(0) = "d"
Dim x As Boolean
x = IsArrayAllocated(Arr)
End Function
Another method would be to do it sooner. You can create a Boolean variable and set it to true once you load data to the array. so all you really need is a simple if statement of when you load data into the array.
To check whether a Byte array is empty, the simplest way is to use the VBA function StrPtr().
If the Byte array is empty, StrPtr() returns 0; otherwise, it returns a non-zero value (however, it's not the address to the first element).
Dim ar() As Byte
Debug.Assert StrPtr(ar) = 0
ReDim ar(0 to 3) As Byte
Debug.Assert StrPtr(ar) <> 0
However, it only works with Byte array.
Function IsVarArrayEmpty(anArray As Variant) as boolean
On Error Resume Next
IsVarArrayEmpty = true
IsVarArrayEmpty = UBound(anArray) < LBound(anArray)
End Function
Maybe ubound crashes and it remains at true, and if ubound < lbound, it's empty
I'll generalize the problem and the Question as intended.
Test assingment on the array, and catch the eventual error
Function IsVarArrayEmpty(anArray as Variant)
Dim aVar as Variant
IsVarArrayEmpty=False
On error resume next
aVar=anArray(1)
If Err.number then '...still, it might not start at this index
aVar=anArray(0)
If Err.number then IsVarArrayEmpty=True ' neither 0 or 1 yields good assignment
EndIF
End Function
Sure it misses arrays with all negative indexes or all > 1... is that likely? in weirdland, yes.
Personally, I think one of the answers above can be modified to check if the array has contents:
if UBound(ar) > LBound(ar) Then
This handles negative number references and takes less time than some of the other options.
You can check if the array is empty by retrieving total elements count using JScript's VBArray() object (works with arrays of variant type, single or multidimensional):
Sub Test()
Dim a() As Variant
Dim b As Variant
Dim c As Long
' Uninitialized array of variant
' MsgBox UBound(a) ' gives 'Subscript out of range' error
MsgBox GetElementsCount(a) ' 0
' Variant containing an empty array
b = Array()
MsgBox GetElementsCount(b) ' 0
' Any other types, eg Long or not Variant type arrays
MsgBox GetElementsCount(c) ' -1
End Sub
Function GetElementsCount(aSample) As Long
Static oHtmlfile As Object ' instantiate once
If oHtmlfile Is Nothing Then
Set oHtmlfile = CreateObject("htmlfile")
oHtmlfile.parentWindow.execScript ("function arrlength(arr) {try {return (new VBArray(arr)).toArray().length} catch(e) {return -1}}"), "jscript"
End If
GetElementsCount = oHtmlfile.parentWindow.arrlength(aSample)
End Function
For me it takes about 0.3 mksec for each element + 15 msec initialization, so the array of 10M elements takes about 3 sec. The same functionality could be implemented via ScriptControl ActiveX (it is not available in 64-bit MS Office versions, so you can use workaround like this).
if Ubound(yourArray)>-1 then
debug.print "The array is not empty"
else
debug.print "EMPTY"
end if
You can check its count.
Here cid is an array.
if (jsonObject("result")("cid").Count) = 0 them
MsgBox "Empty Array"
I hope this helps.
Have a nice day!
Another solution to test for empty array
if UBound(ar) < LBound(ar) then msgbox "Your array is empty!"
Or, if you already know that LBound is 0
if -1 = UBound(ar) then msgbox "Your array is empty!"
This may be faster than join(). (And I didn't check with negative indexes)
Here is my sample to filter 2 string arrays so they do not share same strings.
' Filtering ar2 out of strings that exists in ar1
For i = 0 To UBound(ar1)
' filter out any ar2.string that exists in ar1
ar2 = Filter(ar2 , ar1(i), False)
If UBound(ar2) < LBound(ar2) Then
MsgBox "All strings are the same.", vbExclamation, "Operation ignored":
Exit Sub
End If
Next
' At this point, we know that ar2 is not empty and it is filtered
'
Public Function arrayIsEmpty(arrayToCheck() As Variant) As Boolean
On Error GoTo Err:
Dim forCheck
forCheck = arrayToCheck(0)
arrayIsEmpty = False
Exit Function
Err:
arrayIsEmpty = True
End Function