Good Morning,
I am attempting to create VBA code that will identify if a variable value (number) is found within a string. The string can vary in lenght and can contain 1 or more numbers that are sepearted by a , and a space. I have attempted to use the InStr method but unfortunately if my value is 1 and the string contains a 17 it comes back as true. How can I make it so that would return false since 1 is not equal to 17.
Below is my current code:
'FRB_Code and FRB_Array are variable values within my code but for
'the purpose of this question I have assigned them values.
FRB_Array = "10, 17, 21"
FRB_Code = 1 'ce.Value
If InStr(FRB_Array, FRB_Code) Then
MsgBox "Found"
Else
MsgBox "Not Found"
ce.Delete Shift:=xlUp
End If
Next ce
End If
So the end result should be that the FRB_Code was not found in the FRB_Array and there for the cell was deleted.
Thank you for you help.
You can use an array for that.
Sub FindValue()
Dim sMyString As String
Dim sToFind As String
Dim Arr
Dim i As Long
Dim bFound As Boolean
sMyString = "10, 17, 21"
Arr = Split(sMyString, ", ")
sToFind = "17"
For i = 0 To UBound(Arr)
If Arr(i) = sToFind Then
MsgBox "Found"
bFound = True
Exit For
End If
Next i
If Not bFound Then MsgBox "Not found"
End Sub
Problem is that "1" will "instring" to "1", "217","871", etc. Better to pre-pad and post-pad with spaces:
Sub NumberInString()
BigString = " 1 23 54 79 "
LittleString = " 23 "
MsgBox InStr(1, BigString, LittleString)
End Sub
InStr is not really appropriate here because you are comparing numbers rather than strings. To do what you want split the string into pieces and cycle through the returned array checking each item. Val is used to convert each item in the array to an integer.
bFound = False
FRB_Array = "10, 17, 21"
FRB_Code = 17
ar = Split(FRB_Array, ",")
For i = 0 To UBound(ar)
If FRB_Code = Val(ar(i)) Then
bFound = True
End If
Next i
If bFound Then
MsgBox ("found")
Else
MsgBox ("not found")
End If
You can use REGEX to determine the match.
http://msdn.microsoft.com/en-us/library/twcw2f1c(v=vs.110).aspx
the regex expression would be "1[^\d]|1$" and you would replace 1 with your FB_Code value.
The expression has an or(|) to handle the last number in the array.
Related
I'm new here but hope you all can help with a solution I'm working towards. I'm working on an excel document and setting up a macro. It works until I try to add some logic to pad a number with zero's.
I'm trying to pad zero's in a select cell where the labels are less than 10, then add my integer. If the labels are greater than 9, I want to pad one less zero, likewise when they are greater than 99, one less from those with 10 or more.
My program asks the user how many labels they wish to print (1-999).
I've tried to add an IF statement within my For I = 1 To LabelCount:
For I = 1 To LabelCount
If I < 10 Then
ActiveSheet.Range("C20").Value = "C906BGM0880000" & I
ActiveSheet.PrintPreview
Else
ActiveSheet.Range("C20").Value = "C906BGM088000T" & I
ActiveSheet.PrintPreview
End If
Next
The above did not work.
Sub IncrementPrint()
'updateby Tyler Garretson
Dim LabelCount As Variant
Dim xScreen As Boolean
Dim I As Long
On Error Resume Next
LInput:
LabelCount = Application.InputBox("Please enter the number of copies you want to print:")
If TypeName(LabelCount) = "Boolean" Then Exit Sub
If (ActiveSheet.Range("F11").Value = "") Or (ActiveSheet.Range("F14").Value = "") Or (ActiveSheet.Range("C18").Value = "") Then
MsgBox "Error Occurred. Please enter values for Route, Stop, and Destination Name", vbExclamation
ElseIf (LabelCount = "") Or (Not IsNumeric(LabelCount)) Or (LabelCount < 1) Or (LabelCount > 999) Then
MsgBox "Error Occurred. Please enter 1 - 999", vbExclamation
ElseIf LabelCount < 10 Then
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
For I = 1 To LabelCount
ActiveSheet.Range("C20").Value = "C906BGM0880000" & I
ActiveSheet.PrintPreview
Next
ActiveSheet.Range("C20").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub
User enters 11 labels that he or she wishes to print, the program prints out the following:
Label1: ABC00001
Label2: ABC00002
Label3: ABC00003
Label4: ABC00004
Label5: ABC00005
Label6: ABC00006
Label7: ABC00007
Label8: ABC00008
Label9: ABC00009
Label10: ABC00010
Label11: ABC00011
You want the Format command - Format(1, "00000") = 00001
Format(123,"00000") = 00123
' This might be the basis of what you need
for a = 1 to 1000
b = right("0000000000" & a,8) ' B will always be 8 long and paaded left with 0's
next a
This works well with a text prefix too
for a = 1 to 1000
c = "XYZ" & right("0000000000" & a,8)
next a
As in my title, I'm trying to filter out specific strings from a VBA array, based on an other array.
My code looks something like this :
For Each item In exclusions_list
updated_list = Filter(updated_list, item, False, vbTextCompare)
Next item
My issue is that I only want to exclude exact matches and I can't seem to find a way to do so.
If I have "how" in exclusions_list, I'd like to exclude "how" from updated_list but not "however".
My apologies if this has been asked before. I couldn't find a clear answer and I am not very familiar with VBA.
Thanks !
The Filter method only looks for substrings. It does not have a way of recognizing whole words.
One way to do this is by using Regular Expressions which include a token to recognize word boundaries. This will only work if the substrings you are considering do not include non-Word characters. Word characters are those in the set of [A-Za-z0-9_] (with some exceptions for non-English languages).
For example:
Option Explicit
Sub foo()
Dim arr
Dim arrRes
Dim V
Const sfilter As String = "gi"
Dim col As Collection
arr = Array("Filter", "by", "bynomore", "gi", "gif")
Dim re As Object, MC As Object, I As Long
Set col = New Collection
Set re = CreateObject("vbscript.regexp")
With re
.ignorecase = True
.Pattern = "\b" & sfilter & "\b"
For I = 0 To UBound(arr)
If .test(arr(I)) = False Then _
col.Add arr(I)
Next I
End With
ReDim arrRes(0 To col.Count - 1)
For I = 1 To col.Count
arrRes(I - 1) = col(I)
Next I
End Sub
The resulting array arrRes will contain gif but not gi
Approach via a very simple Replace function
In addition to the valid solutions above and just to demonstrate another approach using a simple Replace function. This solution doesn't pretend to be the most efficient way to execute exclusions.
Example code
Sub Howdy()
' Purpose: exclude exactly matching array items (not case sensitive)
Dim exclusions_list, updated_list, item
exclusions_list = Array("How", "much")
' assign test list (with successive repetitions)
updated_list = Split("Bla bla,How,how,Howdy,However,How,much,much,much,Much,Much,How much,something else", ",")
' Debug.Print UBound(updated_list) + 1 & " items in original list: """ & Join(updated_list, "|") & """"
' execute exclusions
For Each item In exclusions_list
updated_list = modifyArr(updated_list, item) ' call helper function modifyArr()
' Debug.Print UBound(updated_list) + 1 & " items excluding """ & item & """:" & vbTab & """" & _
Join(updated_list, "|") & """"
Next item
End Sub
Note
Not outcommenting the Debug.Print Statements you'd get the following results in the VBE immediate window:
13 items in original list: "Bla bla|How|how|Howdy|However|How|much|much|much|Much|Much|How much|something else"
10 items excluding "How": "Bla bla|Howdy|However|much|much|much|Much|Much|How much|something else"
5 items excluding "much": "Bla bla|Howdy|However|How much|something else"
Helper function modifyArr()
Please note that it's necessary to provide for successive repetitions of strings to be excluded, as a single Replace statement wouldn't exceute every wanted replacement in subsequent string parts.
Function modifyArr(ByVal arr, ByVal item) As Variant
Const C = ",": Dim temp$, sLen$
temp = Replace(C & Join(arr, C) & C, C & item & C, Replace:=C, Compare:=vbTextCompare)
Do While True ' needed to get successive repetitions !
sLen = Len(temp)
temp = Replace(temp, C & item & C, Replace:=C, Compare:=vbTextCompare)
If sLen = Len(temp) Then Exit Do
Loop
' return
modifyArr = Split(Mid$(temp, 2, Len(temp) - 2), C)
End Function
Add a reference to RegEx:
Option Explicit
Sub Filter()
Dim words() As String
words = Split("how,however,test3,test4,,,howevermore,how,whatsohowever,test1,test2", ",")
Dim regex As New RegExp
With regex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = "^how$" ' ^ means must start with and $ means must end with
End With
Dim i As Integer
For i = 0 To UBound(words)
If regex.Test(words(i)) Then
' Debug.Print words(i) + " is an exact match!"
words(i) = vbNullString ' Just clear out item, skip later.
Else
' Debug.Print words(i) + " is NOT a match!"
End If
Next i
For i = 0 To UBound(words)
If (StrPtr(words(i)) <> 0) Then ' We can use this to explicitly catch vbNullString, because "" has a pointer.
Debug.Print words(i)
End If
Next i
End Sub
Initially, I'm not clear why people are getting into RegExp here. RegExp is for complex pattern matching, not an exact match. For more on that point, see another answer here.
Basic Loop
The simplest way to do this is to loop through the array and test each value:
Sub ShowFilterOutExact()
startingArray = Array("Filter", "by", "bynomore", "gi", "gif")
filteredArray = FilterOutExact("gif", startingArray)
End Sub
Function FilterOutExact(exactValue, sourceArray)
'Start with a returnArray the same size as the sourceArray
ReDim returnArray(UBound(sourceArray))
For i = 0 To UBound(sourceArray)
If sourceArray(i) <> exactValue Then
returnArray(matchIndex) = sourceArray(i)
matchIndex = matchIndex + 1
End If
Next
'Now trim the returnArray down to size
ReDim Preserve returnArray(matchIndex - 1)
FilterOutExact = returnArray
End Function
For alternatives to the equal operator (or <> for "does not equal"), this answer has more details.
Replace and Filter
You can also do a workaround with the built in Filter() function to get an exact match.
Function FilterExactMatch(SourceArray, Match, Optional DumpValue = "#/#/#", Optional Include = True)
'Make sure the DumpValue is not found in the sourceArray in any element
For i = LBound(SourceArray) To UBound(SourceArray)
ExactMatch = SourceArray(i) = Match
If ExactMatch Xor Include Then SourceArray(i) = DumpValue
Next
FilterExactMatch = Filter(SourceArray, DumpValue, False)
End Function
Filter out multiple values at once
Finally, it turns out the Application.Match function can check an array of values against an array of values to see if any match. This can be used to filter out multiple values at once (or just one) on an exact basis.
Function FilterOutMultiple(unwantedValuesArray, sourceArray)
If LBound(sourceArray) <> 0 Then
MsgBox "sourceArray argument must be zero-based for this to work as written"
Exit Function
End If
matchArray = Application.Match(sourceArray, unwantedValuesArray, 0)
matchCount = Application.Count(matchArray) 'Count non-error values
ReDim returnArray(UBound(sourceArray) - matchCount)
j = -1
For i = 0 To UBound(sourceArray)
If IsError(matchArray(i + 1)) Then 'Keep the error indexes
j = j + 1
returnArray(j) = sourceArray(i)
End If
Next
FilterOutMultiple = returnArray
End Function
I have a string (Ex: blaZ-34blalba -$'34 ZBG-1004 Zblablabla).
I know the string I need as the form Z$$-%%%%, with $ as string and % as integer, the length of the string will be 8 long too.
I need to get this string apart.
Here is the code I tried ( I saw % and $ should replace string and integer), but it don't seems to work.
Maybe I just don't know what to look for (I did not find any cleans solutions).
Sub test1()
Dim comment As String
Dim name As String
Dim eureka As Integer
Dim posOfZ As Integer
Sheets("Sheet1").Select
comment = Range("A1").Text
posOfZ = InStr(comment, "Z")
name = Mid(comment, posOfZ, 8)
eureka = 1
While eureka = 1
If name <> "Z$$-%%%%" Then
comment = Replace(comment, "Z", "", 1, 1)
posOfZ = InStr(comment, "Z")
name = Mid(comment, posOfZ, 8)
Else
eureka = 0
End If
Wend
End Sub
Well... you'll need to create a function to determine if you have a valid character as in funIsChar (see below). You can modify this function to include any special chars if needed. You may even decide that numbers are ok too and then you don't even have to check for char validity since it's already a string.
Also, don't forget to test for a situation where your format is not found. If you scan the whole string and that format doesn't exist, you'll need to exit the routine gracefully. I put msgbox's in the code to show where exception handling is needed.
Plus, it's best to check IsNumeric for each of the individual 4 chars that are supposed to be a number separately. If you try to do them all at once in one statement, decimals will be considered valid. (Of course, if decimals are allowed, you should consider condensing down to one statement.)
Also, also... I flipped the logic value of your eureka test. Usually (in programming logic) testing for 0 means it's "false" and testing for 1 is "true". So you want to loop while the value has not been found (meaning it's false) and escape from the loop when eureka becomes true (indicating you've found what you were looking for). I also added a new boolean flag booEscapeFlag to help exit the loop if the format is not found. (I'll leave it to you as an exercise if you'd like to change your eureka variable to a boolean as well.)
Sub test1()
Dim comment As String
Dim name As String
Dim eureka As Integer
Dim posOfZ As Integer
Dim booEscapeFlag As Boolean ' New boolean escape from the loop flag
Sheets("Sheet1").Select
comment = Range("A1").Text
posOfZ = InStr(comment, "Z")
If posOfZ > 0 Then ' Test if Z was found, if not, jump to "Z not found" message
name = Mid(comment, posOfZ, 8)
eureka = 0 ' Now set to 0 to indicate it's not found yet
booEscapeFlag = False ' Set boolean flag to false
While eureka = 0 And Not booEscapeFlag ' added test for not escaping yet
If funIsChar(Mid(name, 2, 1)) Then ' "Z$$-%%%%"
If funIsChar(Mid(name, 3, 1)) Then
If Mid(name, 4, 1) = "-" Then
If IsNumeric(Mid(name, 5, 1)) Then
If IsNumeric(Mid(name, 6, 1)) Then
If IsNumeric(Mid(name, 7, 1)) Then
If IsNumeric(Mid(name, 8, 1)) Then
eureka = 1
End If
End If
End If
End If
End If
End If
End If
If eureka <> 1 Then
comment = Replace(comment, "Z", "", 1, 1)
posOfZ = InStr(comment, "Z")
If posOfZ > 0 Then ' Test to see if next Z was found
name = Mid(comment, posOfZ, 8)
Else
MsgBox "Z$$-%%%% format not found"
booEscapeFlag = True ' Set boolean flag to true so we can exit the loop
End If
End If
Wend
If eureka = 1 Then
MsgBox "Found it: " & name
End If
Else
MsgBox "Z not found" ' This msg box was triggered by the first if statement at the top of the subroutine
End If
End Sub
Function funIsChar(strChr) As Boolean
Select Case Asc(strChr)
Case 65 To 90, 97 To 122 ' Ascii 65 - 90 is uppercase letters, 97 - 122 is lowercase letters. You can add more case statements if you need to test for special characters
funIsChar = True
Case Else
funIsChar = False
End Select
End Function
Hope that helps :)
I have a bunch of strings comprising of characters "A","B"..."Z" (and no others). A typical string looks like ABZYC. The strings are given to me in pairs like ABC,ABDC. The strings are comparable if one string is contained in the other (i.e either one of the two strings contain all the alphabets of the other). The order in which the string appears don't matter.
Is there any direct function in excel vba which does this sort of comparison?
Examples:
ACBD,AC - Match
ACBD,CA - Match
ACBD,ADB - Match
AC,ABCD - Match
ABC, ABD - No Match
Add the following function in a module in your workbook:
Function allIn(str1, str2)
' check whether all elements of str1 occur in str2
' and vice versa
Dim l1, l2, ii As Integer
Dim isfound As Boolean
isfound = True
l1 = Len(str1)
l2 = Len(str2)
If l1 < l2 Then
' look for all the elements of str1 in str2
For ii = 1 To l1
If InStr(1, str2, Mid(str1, ii, 1), vbTextCompare) <= 0 Then
isfound = False
Exit For
End If
Next ii
Else
' look for all the elements of str2 in str1
For ii = 1 To l2
If InStr(1, str1, Mid(str2, ii, 1), vbTextCompare) <= 0 Then
isfound = False
Exit For
End If
Next ii
End If
allIn = isfound
End Function
Now you can call this from another place in your code, using result = inStr("ABD", "BAD") - or from the spreadsheet itself. On the spreadsheet you would type =allIn(A3, B6) to compare strings in cells A3 and B6.
Here is what happens when I did that (I entered =allIn(A1, B1) in cell C1, then dragged the formula to the next four rows):
I believe that solves your problem.
EDIT: I just noticed #Philip's comment to your question - I appear to have implemented his suggestion although I had not seen it when I started to compose it... But here's a tip of the hat all the same!
INSTR will find a substring in a string:
Typical_String = "ABZYC"
if instr(Typical_String,"ABC") > 0 then
If you want a Formula solution, a user called Schielrn on the Mr Excel forum site came up with this sublime masterpiece (using ARRAY FORMULAS)
Or, if you want a VBA, try this...
Sub compare()
Dim iIndx As Integer
Dim str1 As String
Dim str2 As String
Dim sLetter As String
Dim bFound As Boolean
Range("A1").Select
bFound = False
Do
str1 = VBA.Trim(ActiveCell.Text)
str2 = VBA.Trim(ActiveCell.Offset(0, 1).Text)
For iIndx = 1 To Len(str1)
If VBA.InStr(str2, VBA.Mid(str1, iIndx, 1)) <> "" Then
' found it
bFound = True
Else
bFound = False
exit for
End If
Next
If bFound = False Then
' check the other way!
For iIndx = 1 To Len(str2)
If VBA.InStr(str1, VBA.Mid(str2, iIndx, 1)) <> "" Then
' found it
bFound = True
Else
bFound = False
exit for
End If
Next
End If
If bFound = True Then ActiveCell.Offset(0, 2).Value = "MATCHED!"
ActiveCell.Offset(1, 0).Select
Loop While Not ActiveCell.Offset(1, 0).Text = ""
End Sub
I missread the post!
Use function EXACT
Compares two text strings and returns TRUE if they are exactly the
same, FALSE otherwise. EXACT is case-sensitive but ignores formatting
differences.
I usually add the function UPPER ie:
A1 = Some Place
B1 = some place
with
=EXACT(UPPER(A1),UPPER(B1)) = EXACT(SOME PLACE, SOME PLACE) = TRUE
Without UPPER
=EXACT(A1,B1) = EXACT(Some Place, some place) = FALSE
I am trying to detect whether an integer was set, and if not, skip most of the code in the loop (using an if statement). Here is what I have so for.
Do While hws.Cells(r, 9).Value <> ""
On Error Resume Next
ar = Null
ar = aws.Range("A:A").Find(hws.Cells(r, 2).Value).Row
If Not IsNull(ar) Then
'work with ar'
End If
r = r + 1
Loop
However, when I run it, ar = Null has problems. It says "Invalid use of null".
Variables defined as Integer cannot be Null in VBA. You will have to find another way to do what you want. eg use a different data type or use a magic number to indicate null (eg -1).
In your example code, either ar will be assigned a Long value (Range.Row is a Long) or it will throw an error.
just use a variant and isempty:
Dim i
If IsEmpty(i) Then MsgBox "IsEmpty"
i = 10
If IsEmpty(i) Then
MsgBox "IsEmpty"
Else
MsgBox "not Empty"
End If
i = Empty
If IsEmpty(i) Then MsgBox "IsEmpty"
'a kind of Nullable behaviour you only can get with a variant
'do you have integer?
Dim j as Integer
j = 0
If j = 0 Then MsgBox "j is 0"
Find returns a range:
Dim rf As Range
With aws.Range("A:A")
Set rf = .Find(hws.Cells(r, 2).Value)
If Not rf Is Nothing Then
Debug.Print "Found : " & rf.Address
End If
End With
-- http://msdn.microsoft.com/en-us/library/aa195730(office.11).aspx