Excel VBA Function Not Finding Exact Match in Array [duplicate] - arrays

If UBound(Filter(myArray, Sheets(i).Cells(1, j).Value, True)) = -1 Then
'take action
End if
I used this syntax to compare an element found in Cells(1, j) (e.g. "ally") to all the elements of an array (e.g. "mally", "kate", "becks"), and to take action when no exact match is found.
Trouble is, based on this line of code it seems "ally" is considered as matching "mally" (probably because "ally" is a substring from "mally"), whereas I want "ally" to be recognised as distinct from "mally".
Any help with the syntax as to achieve this? Thank you!

IsInArray = Not IsError(Application.Match(stringToBeFound, arr, 0))

Filter will return any items that partially match. The work around suggested by Microsoft is to then search the filtered array for exact matches.
Function FilterExactMatch(astrItems() As String, _
strSearch As String) As String()
' This function searches a string array for elements
' that exactly match the search string.
Dim astrFilter() As String
Dim astrTemp() As String
Dim lngUpper As Long
Dim lngLower As Long
Dim lngIndex As Long
Dim lngCount As Long
' Filter array for search string.
astrFilter = Filter(astrItems, strSearch)
' Store upper and lower bounds of resulting array.
lngUpper = UBound(astrFilter)
lngLower = LBound(astrFilter)
' Resize temporary array to be same size.
ReDim astrTemp(lngLower To lngUpper)
' Loop through each element in filtered array.
For lngIndex = lngLower To lngUpper
' Check that element matches search string exactly.
If astrFilter(lngIndex) = strSearch Then
' Store elements that match exactly in another array.
astrTemp(lngCount) = strSearch
lngCount = lngCount + 1
End If
Next lngIndex
' Resize array containing exact matches.
ReDim Preserve astrTemp(lngLower To lngCount - 1)
' Return array containing exact matches.
FilterExactMatch = astrTemp
End Function
This code is taken from http://msdn.microsoft.com/en-us/library/office/aa164525%28v=office.10%29.aspx

If the array is only used for this comparison and not needed for anything else you could also force full word comparisons by adding your own delimiters that never appear in the data - maybe square brackets.
So if you change your array to contain "[mally]", "[kate]", "[becks]"
then your condition becomes:
If UBound(Filter(myArray, "[" & Sheets(i).Cells(1, j).Value & "]", True)) = -1

If you do not need to use Filter then the below snippet would work
Dim v
Dim bMatch As Boolean
bMatch = False
For Each v In myArray
'compare strings
If StrComp(CStr(v), Sheets(i).Cells(1, j).Value, vbTextCompare) = 0 Then
bMatch = True
End If
Next
If Not bMatch Then
'do something
End If

Related

VBA check if whole row of multidimensional variant is empty without loops

Is there a quick way to check whether a whole row of a variant is empty?
My multi-dimensional array / variant has n-rows and m-columns.
The only way I can think of is to loop through the columns (of a specific row) and use the IsEmpty() function to determine if a cell is empty.
The variant only consists strings.
Do you know a faster way? Maybe something like this pseudo-code: IsEmpty(myarr(1,*))
this pseudocode would mean to check the all columns of the first row if they are empty.
You could try something like:
Sub Test()
Dim myarr() As Variant, indx As Long
myarr = Range("A8:C20").Value 'Or however you initialize your array.
indx = 1 'Or whichever row you would want to check.
With Application
Debug.Print Join(.Index(myarr, indx, 0), "") <> ""
End With
End Sub
Not sure if it will be faster than a loop though, since we call a worksheet application.
No, there isn't a faster way especially considering that arrays in VBA are stored column-wise in memory. The values on a single row are not stored adjacent in memory as it's the case with column values - you could easily test this by running a For Each loop on an array.
That being said, you should probably consider having a Function that checks if a specific row is empty so that you can call it repeatedly and maybe also check for null strings if needed. For example a range of formulas returning "" will not be empty but you might want to have the ability to consider them empty.
For example, you could use something like this:
Public Function Is2DArrayRowEmpty(ByRef arr As Variant _
, ByVal rowIndex As Long _
, Optional ByVal ignoreEmptyStrings As Boolean = False _
) As Boolean
Const methodName As String = "Is2DArrayRowEmpty"
'
If GetArrayDimsCount(arr) <> 2 Then
Err.Raise 5, methodName, "Array is not two-dimensional"
ElseIf rowIndex < LBound(arr, 1) Or rowIndex > UBound(arr, 1) Then
Err.Raise 5, methodName, "Row Index out of bounds"
End If
'
Dim j As Long
Dim v As Variant
'
For j = LBound(arr, 2) To UBound(arr, 2)
v = arr(rowIndex, j)
Select Case VBA.VarType(v)
Case VbVarType.vbEmpty
'Continue to next element
Case VbVarType.vbString
If Not ignoreEmptyStrings Then Exit Function
If LenB(v) > 0 Then Exit Function
Case Else
Exit Function
End Select
Next j
'
Is2DArrayRowEmpty = True 'If code reached this line then row is Empty
End Function
Public Function GetArrayDimsCount(ByRef arr As Variant) As Long
If Not IsArray(arr) Then Exit Function
'
Const MAX_DIMENSION As Long = 60
Dim dimension As Long
Dim tempBound As Long
'
'A zero-length array has 1 dimension! Ex. Array() returns (0 to -1)
On Error GoTo FinalDimension
For dimension = 1 To MAX_DIMENSION
tempBound = LBound(arr, dimension)
Next dimension
Exit Function
FinalDimension:
GetArrayDimsCount = dimension - 1
End Function
Notice that I haven't checked for IsObject as your values are coming from a range in Excel but you would normally check for that in a general case.
Your pseudocode IsEmpty(myarr(1,*)) could be translated to:
Is2DArrayRowEmpty(myarr, 1, False) 'Empty strings would not be considered Empty
or
Is2DArrayRowEmpty(myarr, 1, True) 'Empty strings would be considered Empty

How to speed up extracting numbers from chemical formula

I have been using some useful VBA code by PEH that uses regular expression to extract the number of instances of a specific element in a chemical formula, see: https://stackoverflow.com/a/46091904/17194644
It works well, but everything slows down when I use the function hundreds of times in one worksheet. I was wondering if this might be due to the time it takes VBA to read/write values from/to the cells, so I created an array function (based on the regex code by PEH) to see if it would speed things up, see below. The function works and is quicker but can still slow things down when dealing with hundreds of values, and I cannot get the second part to work that finds multiplies elements within parenthesis. Any thoughts on how to improve further?
Function CountElements(ChemFormulaRange As Variant, ElementRange As Variant) As Variant
'define variables
Dim RetValRange() As Long
Dim RetVal As Long
Dim ChemFormula As String
Dim npoints As Long
Dim i As Long
Dim mpoints As Long
Dim j As Long
' Convert input ranges to variant arrays
If TypeName(ChemFormulaRange) = "Range" Then ChemFormulaRange = ChemFormulaRange.Value
If TypeName(ElementRange) = "Range" Then ElementRange = ElementRange.Value
'parameter
npoints = UBound(ChemFormulaRange, 1) - LBound(ChemFormulaRange, 1) + 1
mpoints = UBound(ElementRange, 2) - LBound(ElementRange, 2) + 1
'dimension arrays
ReDim RetValRange(1 To npoints, 1 To mpoints)
'calculate all values
For j = 1 To mpoints
Element = ElementRange(1, j)
For i = 1 To npoints
RetVal = 0
ChemFormula = ChemFormulaRange(i, 1)
Call ChemRegex(ChemFormula, Element, RetVal)
RetValRange(i, j) = RetVal
Next i
Next j
'output answer
CountElements = RetValRange
End Function
Private Sub ChemRegex(ChemFormula, Element, RetVal)
Dim regEx As New RegExp
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
End With
'first pattern matches every element once
regEx.Pattern = "([A][cglmrstu]|[B][aehikr]?|[C][adeflmnorsu]?|[D][bsy]|[E][rsu]|[F][elmr]?|[G][ade]|[H][efgos]?|[I][nr]?|[K][r]?|[L][airuv]|[M][cdgnot]|[N][abdehiop]?|[O][gs]?|[P][abdmortu]?|[R][abefghnu]|[S][bcegimnr]?|[T][abcehilms]|[U]|[V]|[W]|[X][e]|[Y][b]?|[Z][nr])([0-9]*)"
Dim Matches As MatchCollection
Set Matches = regEx.Execute(ChemFormula)
Dim m As Match
For Each m In Matches
If m.SubMatches(0) = Element Then
RetVal = RetVal + IIf(Not m.SubMatches(1) = vbNullString, m.SubMatches(1), 1)
End If
Next m
'second patternd finds parenthesis and multiplies elements within
' regEx.Pattern = "(\((.+?)\)([0-9])+)+?"
' Set Matches = regEx.Execute(ChemFormula)
' For Each m In Matches
' RetVal = RetVal + ChemFormula(m.SubMatches(1), Element) * (m.SubMatches(2) - 1) '-1 because all elements were already counted once in the first pattern
' Next m
End Sub
If you are using Office 365, then you do not need VBA. A formula can achieve what you want and I think it would be faster.
=TRIM(TEXTJOIN("",TRUE,IFERROR((MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1)*1)," ")))
Note: If you still need a VBA solution then remember you can enter the above formula in the entire range in one go and then convert it to values.
rng.Formula = "=TRIM(TEXTJOIN("""",TRUE,IFERROR((MID(A1,ROW(INDIRECT(""1:""&LEN(A1))),1)*1),"" "")))"
rng.Value = rng.Value
The slowest part of your ChemRegex routine is creating the RegExp object.
If all your cells are passed to CountElements as a pair of large areas move the code that creates the RegExp object and applies a few properties from ChemRegex to CountElements, and pass the RegExp reference from CountElements to ChemRegex.
Or, if you are calling CountElements as say a UDF in multiple cells, declare RegExp at module level
Private RegEx as RegExp
In CountElements...
If RegEx is Nothing Then
Set RegEx = New RegExp
' apply the properties
End If
' code
' and pass RegEx to ChemRegex
Call ChemRegex(ChemFormula, Element, RetVal, RegEx)
Isolate all numbers in chemical formula
Just for the sake of the art an alternative to Siddharth 's approach, where I demonstrate how to use Match() comparing
an array of each formula character|digit in the given string with
an array of all regular digits.
This allows to identify array elements (here: digits) based on their position. So this demo might be also helpful to solve similar requirements. - I don't pretend this to be a better or faster way.
Function ChemNo(ByVal s As String) As Variant
'Purp: return array of found character positions in chars string
'Note: (non-findings show Error 2042; can be identified by IsError + Not IsNumeric)
Dim digits
digits = String2Arr("1234567890")
'get any digit position within array digits ' note: zero position returns 10
Dim tmp
tmp = Application.Match(String2Arr(s), digits, 0)
'check for digits in a loop through tmp
Dim i As Long, ii As Long
For i = 1 To UBound(tmp)
If IsNumeric(tmp(i)) Then ' found digit
tmp(i) = tmp(i) Mod 10 ' get digtis including zeros
If IsNumeric(tmp(i - 1)) Then ' check preceding digit
tmp(i) = 10 * tmp(i - 1) + tmp(i) ' complete number
tmp(i - 1) = "!" ' mark former digit
End If
Else
tmp(i) = "!" ' mark non-numeric element
End If
Next i
ChemNo = Filter(tmp, "!", False) ' delete marked elements
End Function
Help function String2Arr()
Assigns an array of single characters after atomizing a string input:
Function String2Arr(ByVal s As String) As Variant
'Purp: return array of all single characters in a string
'Idea: https://stackoverflow.com/questions/13195583/split-string-into-array-of-characters
s = StrConv(s, vbUnicode)
String2Arr = Split(s, vbNullChar, Len(s) \ 2)
End Function
If you want to use the function as tabular input profiting from the newer dynamic features in Excel, you may enter it as user defined function e.g. in cell B1: =ChemNo(A1) displaying each number horizontally in as so called spill range. Using older versions, I suppose you'd need a CSE entry (Ctrl↑┘) to mark it as {array} formula.

Filtering out Numbers from Array

So I have an Array called TagOptions - it contains numeric values according to a pervious if statement. In order to take out values I didn't want I gave the undesired values a place holder value of 0. I am now trying to filter out this value but can't find anything online that is helpful.
Will paste the entire function for context but more interested in just filtering out the placeholder zeros from my array.
Sorry if this is novice but I am very new to this:
Private Sub CommandButton4_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("TEST")
lrow = sh.Cells(Rows.count, 1).End(xlUp).Row
Dim splitstring As String
Dim holder As String
Dim myarray() As String
Dim strArrayNumber() As Integer
Dim strArrayTag() As String
Dim TagOptions() As Integer
Dim TagOptions2() As Integer
ReDim strArrayNumber(1 To lrow) As Integer
ReDim strArrayTag(1 To lrow) As String
'Initial for loop splitting tags and removing any tags with text (MV-4005A)
'Transfering those remaining tag numbers into array if they match equip selected
For a = 1 To lrow
If sh.Cells(a, 1).Value <> vbNullString Then
splitstring = sh.Cells(a, 1).Value
myarray = Split(splitstring, "-")
strArrayTag(a) = myarray(0)
End If
If IsNumeric(myarray(1)) = False Then
myarray(1) = 0
End If
If strArrayTag(a) = TagNumber1.Value Then 'Only stored if has selected Equipment tag
strArrayNumber(a) = myarray(1)
End If
Next a
'Sort Created Array
Quicksort strArrayNumber, LBound(strArrayNumber), UBound(strArrayNumber)
ReDim TagOptions(1000 To 2000) As Integer
Dim j As Integer
For j = 1000 To 2000
For b = 1 To UBound(strArrayNumber)
If strArrayNumber(b) = j Then
TagOptions(j) = 0
Exit For
Else
TagOptions(j) = j
End If
Next b
sh.Cells(j, 8) = TagOptions(j)
Next j
Quicksort TagOptions, LBound(TagOptions), UBound(TagOptions)
For f = LBound(TagOptions) To UBound(TagOptions)
sh.Cells(f, 9) = TagOptions(f)
Next f
**TagOptions2 = Filter(TagOptions, "0", False, vbDatabaseCompare)**
Me.ComboBox1.List = TagOptions
End Sub
Thnak you in advance for any help.
tl;dr entire code, just note that VBA's Filter() function applied on a "flat" 1-dim array only executes a partial character search finding "0" also in strings like e.g. "10" or "205", what definitely isn't what you want to do :-;
Btw, if your initial array is a 2-dim array, there are number of answers at SO how to slice data from a 2-dim array and transpose or double transpose them to a 1-dim array needed as starting point.
Solving the actual core question how to filter out zero-digits
To succeed in filtering out zeros in a 1-dim array, simply use the following function via the Worksheetfunction FilterXML (available since vers. 2013+):
tagOptions = WorksheetFunction.FilterXML("<t><s>" & _
Join(tagOptions, "</s><s>") & "</s></t>", _
"//s[not(.='0')]")
resulting in a 1-based 2-dim array.
If you prefer, however to get a resulting 1-dim array instead, simply transpose it via tagOptions = Application.Transpose(tagOptions) or tagOptions = WorkSheetFunction.Transpose(tagOptions).
You can find an excellent overview at Extract substrings ... from FilterXML

VBA copy values from one array and store them into another

I am hoping to find help with this current VBA problem. I have looked throughout Stack Overflow and other Google searches, but can't seem to find what I'm looking for.
Essentially, I have a user pasted value on my page which I am delimiting on a comma, and then storing that into an array. What I am aiming to do is then loop through that array and eliminate any extra spaces, and then also delete any values that AREN'T a number.
Copy user values
Store into an array
Erase whitespace
So far, I have not been able to:
Copy items that ARE a number to new array
Currently, my code looks like:
Sub grabText()
' This macro was written as a test macro to grab and filter data entered in a textbox
Application.ScreenUpdating = False
Dim enteredValue As String ' Value taken from page
Dim vals() As String ' Array once it is split
Dim goodvals() As String 'Formatted array
Dim i As Integer 'Index
enteredValue = ActiveSheet.myTxt.Text
' MsgBox enteredValue
vals() = Split(enteredValue, ",")
lastitem = UBound(vals)
' MsgBox lastitem
'Formats array
For i = LBound(vals) To UBound(vals)
i = TRIM(vals(i))
'
' If (ISNUMBER(vals(i)) == TRUE) Then
' enter i into goodvals()
'
Next i
Application.ScreenUpdating = True
Any help or advice would be greatly appreciated. I was thinking about ways to do this in other languages (Java, Python) and I was thinking about Linked-Lists.
Thanks in advance!
Some issues:
Don't assign the result of Split to vals(), but to vals
Don't re-use the variable i for the result of the Trim. It is better to use a separate variable for that, which you can then type as a String
You can capture the desired result if you
First reserve enough room for your target array: it can never be longer than the Split result, so use that as the initial size
Use a separate index variable for referencing the target array index, and only increment it when you have stored a number in it
Finally reduce the size of the target array to the size that was actually used
Code:
Dim enteredValue As String ' Value taken from page
Dim vals() As String ' Array once it is split
Dim goodvals() As String 'Formatted array
Dim i As Long 'Index in vals
Dim j As Long 'Index in goodvals
Dim s As String 'Individual string
enteredValue = ActiveSheet.myTxt.Text
vals = Split(enteredValue, ",")
' Reserve as many entries in the target array
ReDim goodvals(UBound(vals))
j = LBound(goodvals)
For i = LBound(vals) To UBound(vals)
s = Trim(vals(i))
If IsNumeric(s) Then
goodvals(j) = CDbl(s)
MsgBox goodvals(j)
j = j + 1
End If
Next
' Shorten the array size to the part that is used
If j Then
ReDim Preserve goodvals(j - 1)
Else ' There were no numericals at all, so erase the array:
Erase goodvals
End If

Conditionial Concatenation in VBA

Short disclaimer: This is my very first question, so please be understanding.
I'm trying to code a function in Excel VBA that takes a binary number (formatted as a string) that counts the spaces, the 0s, and outputs the consecutive amount of 0s (and adds one to it) until the next "1" in that string appears, with "," in between. At the very end of the string, if there's the a "1", the output should look like: "..., 1". I'll try to make a little easier to understand with an example:
Strings of length twelve:
101011010101 --> 2, 2, 1, 2, 2, 2, 1
110000101101 --> 1, 5, 2, 1, 2, 1
100010001000 --> 4, 4, 4
So far I've managed to make a one-dimensional boolean array that takes the string and splits it into parts of length 1, so to say a "binary array". But I couldn't test it, since I only have half of the function.
Function ABSTAND(str As String, size As Integer) As String
Dim i As Integer
Dim arrays(size) As Boolean
For i = 1 To Len(str)
If Mid(str, i, 1) = "1" Then
arrays(i) = True
Else
arrays(i) = False
End If
'Maybe all of this works in a loop?
'Count consecutive 0s, add one
'Output the value with ", " (Concatenate numbers with strings, or make the number a string)
'Count consecutive 0s again
'and so on...
'Add conditions for the last value: Don't add a ", " and check if a one is the last character
End Function
I know, it looks like I have already figured out the problem and only need to implement it, but I'm new to VBA and don't know that well how it works and how to fix syntax and other problems.
Also, I would like to have a generalized form of my problem, that works with every string length, if that's possible.
Unfortunately, VBA isn't the best language for dealing with arrays. I've written the function as described but it sounds like, from your description, you might want to remove the check for If Len(arrZeroes(i)) > 0 Then etc. because it looks like you want to return '1' values in those cases.
Have a play around with the 'Split' function to try get a better feel for it and how it relates to your problem.
Function ABSTAND(str As String) As String
Dim arrZeroes() As String
Dim arrResult() As String
Dim i As Integer
'Initialise arrResult dimensions
ReDim arrResult(1 To 1)
'Splits your binary number into an array with each element being zero or more 0's
'(if there are several 1's in a row or a 1 at the start or finish it returns 0-length element for that position)
arrZeroes = Split(str, "1")
'Loop through each element in this new array
For i = LBound(arrZeroes) To UBound(arrZeroes)
'Sets the top element of the result array to this length + 1 then increments the size (like appending to array)
arrResult(UBound(arrResult)) = Len(arrZeroes(i)) + 1
ReDim Preserve arrResult(1 To UBound(arrResult) + 1)
Next i
'The last step on the result array incremented its ubound which is still empty so we remove that
ReDim Preserve arrResult(1 To UBound(arrResult) - 1)
'then return the array joined!
ABSTAND = Join(arrResult, ", ")
End Function
Let me know if anything doesn't make sense!
Edit:
An array is basically like an indexed list of elements of a specified data type. The line Dim arrZeroes() as String is dimming a dynamic array of string elements. The benefit of using a dynamic array is that you can dynamically change the amount of elements in it using Redim. To get around the lack of an 'append' function, what you have to do is redim the array to make it one element bigger then set this new biggest element to your new value.
arrResult(UBound(arrResult)) = Len(arrZeroes(i)) + 1
ReDim Preserve arrResult(1 To UBound(arrResult) + 1)
That's what these lines are doing. What the Split function does is, given a string and a delimiter, cut the string into a load of slices at each occurrence of the delimiter and return the array. For example, Split("11101101", "0") returns {"111", "11", "1"}. Where there are more than one occurrence of the delimiter in sequence, or the delimiter appears at the beginning or end of the string, it outputs a zero-length element, such as Split("101101", "1") returns {, "0", , "0",}. What the function is doing is looking at the length of each of these slices (i.e. consecutive digits that are not the delimiter) and outputting them to a new array.
Remove the # in your code.
It is used for preprocessing directive, and you do not need it.
More about Preprocessing directives:
https://msdn.microsoft.com/VBA/Language-Reference-VBA/articles/ifthenelse-directive
In general, try the following code:
Option Explicit
Public Sub TestMe()
Debug.Print ABSTAND("101011010101", 12)
End Sub
Function ABSTAND(str As String, size As Long) As String
Dim i As Long
Dim arrays() As Variant
Dim strResult As String
ReDim arrays(size)
For i = 1 To Len(str)
If Mid(str, i, 1) = "1" Then
arrays(i) = True
Else
arrays(i) = False
End If
strResult = strResult & arrays(i)
Next i
ABSTAND = strResult
End Function
It would print something like TrueFalseTrueFalseTrueTrue... Then try to build up your solution further.
Just some points:
Pay attention how the Array is created.
Use Long instead of Integer.
You can shorten the ABSTAND function, to the following:
Function ABSTAND(str As String, size As Long) As String
Dim i As Long
Dim arrays() As Variant
Dim strResult As String
ReDim arrays(size)
For i = 1 To Len(str)
arrays(i) = Mid(str, i, 1) = "1"
strResult = strResult & arrays(i)
Next i
ABSTAND = strResult
End Function

Resources