Sorry if this has been posted elsewhere as I could not find the answer.
I'm trying to search for any number followed by the letter "m" using the InStr function. I've got the following code which I thought should have worked however it does not recognise "1m" 1.1m" or any variation and returns 0.
Public Function instrstring(strTest As String) As Long
Dim i As Long
PosOfFirstDigit = 0
For i = 1 To Len(strTest)
If Mid$(strTest, i, 1) Like "#" & "m" Then
PosOfFirstDigit = i
Exit For
End If
Next
End Function
I appreciate your help!
To return the position of the match something like this:
For
"a1.1m"
"testme 1m"
"testme 222"
Returns
2
8
not found
Sub Impeached()
Debug.Print StrOut("a1.1m")
Debug.Print StrOut("testme 1m")
Debug.Print StrOut("testme 222")
End Sub
code
Public Function StrOut(strIn As String) As String
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Pattern = "(\d*\.)?\dm"
If .Test(strIn) Then
StrOut = InStr(strIn, .Execute(strIn)(0))
Else
StrOut = "not found"
End If
End With
End Function
As #Tim Williams has mentioned, it's best using regular expressions (Regex) for this if you're having floats as well as integers.
You'll need to setup the reference to Regex to use it. Add VBA reference to "Microsoft VBScript Regular Expressions 5.5"
The regex you'll need is
Dim RE As New RegExp
With RE
.Global = True
.Pattern = "\d*?\.\dm"
End With
If RE.Test(strTest) Then
Msgbox("Found!")
'Insert the function you want to perform here
End If
Related
Is it true that you cannot declare a visual basic array of a size provided by a variable? This seems like a reasonable requirement for any scripting language, and so I expect I am doing something wrong.
In the following example...
Sub TestRoutine()
Dim tVar As Integer: tVar = 5
Dim tArr(tVar) As String
tArr(3) = "SUCCESS"
MsgBox tArr(3)
End Sub
... the execution fails with the message Compile error: Constant expression required
I use a dynamic array instead, but this seems like an ugly workaround. Is there something I am missing here?
That is right. The closest you can get is - as the compiler suggests - to use a constant:
Sub TestRoutine()
Const tVar As Integer = 5
Dim tArr(tVar) As String
tArr(3) = "SUCCESS"
MsgBox tArr(3)
End Sub
Another option which is handy, say, when using Split or Array, is to use a Variant:
Sub TestRoutine()
Dim vArr As Variant
vArr = Array("0", "1", "2", "Yet a SUCCESS")
MsgBox vArr(3)
End Sub
I have a string sStr that contains letters and numbers.I'm trying to remove letters from a string.
For eg: sStr= "P441" or sometimes sStr="BK471" .
I tried using
Right(sStr,3) and split
which gives me 441. since the string sStr may contain 2 letters ("BK471") sometimes, how do i remove letters in vba .
You can loop through each character in the string checking if it IsNumeric
Dim x as integer
Dim sCleanedStr As String
For x = 1 to Len(sStr)
If IsNumeric(Mid(sStr, x, 1)) then sCleanedStr = sCleanedStr & Mid(sStr, x, 1)
Next
You can use Regular Expressions to remove any letters. For this, you need to include the Regex library in your macro (Go to Tools -> References, then search and select the regular expressions library)
Sub test()
sStr = "abc123"
Dim regEx As New RegExp
With regEx
.Pattern = "[a-z]+"
.Global = True
.IgnoreCase = True
End With
sStr = regEx.Replace(sStr, "")
MsgBox (sStr)
End Sub
The above code will replace any letter from anywhere in the word.
I have the a myRegex function to extract Regexes from a string. When I run a query that uses the function I get the following error on multiline.
Method or data member not found.
This is the regex Function:
Function myRegex(ByRef myString As String, ByVal pattern As String) As String
Dim rgx As New RegExp
Dim colMatches As MatchCollection
With rgx
.pattern = pattern
.ignoreCase = True
.Global = False
.Multiline = False
Set colMatches = .Execute(myString)
End With
If colMatches.Count > 0 Then
myRegex = colMatches(0).Value
Else
myRegex = ""
End If
End Function
This is the query I used:
SELECT myRegex(phone,"[0-9]+")
FROM table1
I have the following reference libraries checked:
Microsoft VBScript Regular Expressions 1.0
Microsoft VBScript Regular Expressions 5.5
The following line
Dim rgx As New RegExp
...matches RegExp with the first library that defines that Class, which is
Microsoft VBScript Regular Expressions 1.0
This is an older version that does not support the Multiline property. You need the RegExp class from:
Microsoft VBScript Regular Expressions 5.5
So either:
Remove the link with that older 1.0 reference library, or
Qualify the RegExp class as VBScript_RegExp_55.RegExp, or
Use late binding (slower), with CreateObject("VBScript.RegExp")
You can uncheck the first VBScript Regular Expressions reference ... the 1.0 version ... as #trincot suggests.
Or you could uncheck both references and use late binding:
'Dim rgx As New RegExp
Dim rgx As Object
Set rgx = CreateObject("VBScript.RegExp")
However, since your query will call the function repeatedly, you may notice better performance with a Static object variable.
Function myRegex(ByRef myString As String, ByVal pattern As String) As String
Static rgx As Object
Dim colMatches As Object
If rgx Is Nothing Then
' create the RegExp object just once
Set rgx = CreateObject("VBScript.RegExp")
With rgx
.ignoreCase = True
.Global = False
.Multiline = False
End With
End If
rgx.pattern = pattern
Set colMatches = rgx.Execute(myString)
If colMatches.Count > 0 Then
myRegex = colMatches(0).Value
Else
myRegex = ""
End If
End Function
Am I reinventing the wheel here? Is there a better way to do this? This VBA function looks for the first instance of a string in the comment field of a form in Access containing 20 characters or less, no spaces, surrounded by (~) tildes, then returns it.
Public Function ParseComment(strComment As String) As String
' This function parses the comment field of the job entry dialog for (~) tilde
' surrounded text, then returns that text.
Dim intCounter As Integer
Dim intFirstChar As Integer
Dim intLastChar As Integer
Dim strResult As String
intFirstChar = 0
intLastChar = 0
intCounter = 0
Do While (intLastChar = 0) And (intCounter < Len(strComment))
intCounter = intCounter + 1
strCharacter = Mid(strComment, intCounter, 1)
If (strCharacter = "~") Then
If intFirstChar Then
intLastChar = intCounter
Else
intFirstChar = intCounter + 1
End If
End If
Loop
strResult = Mid(strComment, intFirstChar, intLastChar - intFirstChar)
If (intLastChar - intFirstChar <= 20) And (intFirstChar <> 0 Or intLastChar <> 0) And Not InStr(strResult, " ") Then
ParseComment = strResult
End If
End Function
Thanks much.
I would use InStr to find the first and second occurences of the ~ character, something like this, rather than looping manually:
Public Function ParseComment(strComment As String) As String
' This function parses the comment field of the job entry dialog for (~) tilde
' surrounded text, then returns that text.
Dim firstTilde As Integer
Dim secondTilde As Integer
Dim strResult As String
firstTilde = 0
secondTilde = 0
strResult = ""
firstTilde = InStr(strComment, "~")
If firstTilde > 0 Then
secondTilde = InStr(firstTilde + 1, strComment, "~")
If (secondTilde > 0) And (secondTilde < 20) Then
strResult = Mid(strComment, firstTilde, secondTilde)
If InStr(strResult, " ") = 0 Then
ParseComment = strResult
End If
End If
End If
End Function
[Disclaimer, I haven't tested this!]
Using the built-in functions might be a little quicker, but don't imagine it will make a critical difference...
Something like:
Public Function getTildeDelimStringPart(inputstring As String) As String
Dim commentStart As Long, commentEnd As Long
commentStart = InStr(1, inputstring, "~")
If commentStart = 0 Then ' no tilde
getTildeDelimStringPart = vbNullString
Exit Function
End If
commentEnd = InStr(1 + commentStart, inputstring, "~")
If commentEnd = 0 Then
getTildeDelimStringPart = vbNullString
Exit Function
End If
getTildeDelimStringPart = Mid(inputstring, commentStart, commentEnd - commentStart + 1)
End Function
I see everyone has given you some more ways to do this (instr is a great way, see Vicky's answer!), so I'll just list up some tips on optimizing your code:
Use Long instead of Integer. VBA will convert them to Long every time.
Default value for Int and Long is 0 in VBA, so no need to declare them so.
Use Mid$ instead of Mid
Using Instr() would be a very effecient way to find location of ~
Fun Tip: If you do want to evaluate each character, fastest way is numeric comparision:
if Asc(Mid$(strComment, intCounter, 1)) = 126 Then
This worked for me:
Public Function ParseComment(strComment As String) As String
Dim regex As Object ' VBScript_RegExp_55.RegExp
Dim regexmatch As Object ' VBScript_RegExp_55.MatchCollection
Set regex = CreateObject("VBScript_RegExp_55.RegExp")
With regex
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "(~[^ ~]{1,20}~)"
End With
Set regexmatch = regex.Execute(strComment)
If regexmatch.Count > 0 Then
ParseComment = regexmatch(0)
End If
End Function
You can add additional parsing at the end if you want to remove the tilde characters.
I tested it on the following string:
ABC~123aA%dwdD~CBA
the function returns ~123aA%dwdD~
Forgot to mention that this code requires VBScript Regular Expressions 5.5 which is located in %windir%\system32\vbscript.dll\3, although the code is late bound so you should just be able to drop it into your project.
How do I do a search and replace of text within a module in Access from another module in access? I could not find this on Google.
FYI, I figured out how to delete a module programatically:
Call DoCmd.DeleteObject(acModule, modBase64)
I assume you mean how to do this programatically (otherwise it's just ctrl-h). Unless this is being done in the context of a VBE Add-In, it is rarely (if ever) a good idea. Self modifying code is often flagged by AV software an although access will let you do it, it's not really robust enough to handle it, and can lead to corruption problems etc. In addition, if you go with self modifying code you are preventing yourself from ever being able to use an MDE or even a project password. In other words, you will never be able to protect your code. It might be better if you let us know what problem you are trying to solve with self modifying code and see if a more reliable solution could be found.
After a lot of searching I found this code:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Function to Search for a String in a Code Module. It will return True if it is found and
'False if it is not. It has an optional parameter (NewString) that will allow you to
'replace the found text with the NewString. If NewString is not included in the call
'to the function, the function will only find the string not replace it.
'
'Created by Joe Kendall 02/07/2003
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function SearchOrReplace(ByVal ModuleName As String, ByVal StringToFind As String, _
Optional ByVal NewString, Optional ByVal FindWholeWord = False, _
Optional ByVal MatchCase = False, Optional ByVal PatternSearch = False) As Boolean
Dim mdl As Module
Dim lSLine As Long
Dim lELine As Long
Dim lSCol As Long
Dim lECol As Long
Dim sLine As String
Dim lLineLen As Long
Dim lBefore As Long
Dim lAfter As Long
Dim sLeft As String
Dim sRight As String
Dim sNewLine As String
Set mdl = Modules(ModuleName)
If mdl.Find(StringToFind, lSLine, lSCol, lELine, lECol, FindWholeWord, _
MatchCase, PatternSearch) = True Then
If IsMissing(NewString) = False Then
' Store text of line containing string.
sLine = mdl.Lines(lSLine, Abs(lELine - lSLine) + 1)
' Determine length of line.
lLineLen = Len(sLine)
' Determine number of characters preceding search text.
lBefore = lSCol - 1
' Determine number of characters following search text.
lAfter = lLineLen - CInt(lECol - 1)
' Store characters to left of search text.
sLeft = Left$(sLine, lBefore)
' Store characters to right of search text.
sRight = Right$(sLine, lAfter)
' Construct string with replacement text.
sNewLine = sLeft & NewString & sRight
' Replace original line.
mdl.ReplaceLine lSLine, sNewLine
End If
SearchOrReplace = True
Else
SearchOrReplace = False
End If
Set mdl = Nothing
End Function
Check out the VBA object browser for the Access library. Under the Module object you can search the Module text as well as make replacements. Here is an simple example:
In Module1
Sub MyFirstSub()
MsgBox "This is a test"
End Sub
In Module2
Sub ChangeTextSub()
Dim i As Integer
With Application.Modules("Module1")
For i = 1 To .CountOfLines
If InStr(.Lines(i, 1), "This is a Test") > 0 Then
.ReplaceLine i, "Msgbox ""It worked!"""
End If
Next i
End With
End Sub
After running ChangeTextSub, MyFirstSub should read
Sub MyFirstSub()
MsgBox "It worked!"
End Sub
It's a pretty simple search but hopefully that can get you going.
additional for the function (looping through all the lines)
Public Function ReplaceWithLine(modulename As String, StringToFind As String, NewString As String)
Dim mdl As Module
Set mdl = Modules(modulename)
For x = 0 To mdl.CountOfLines
Call SearchOrReplace(modulename, StringToFind, NewString)
Next x
Set mdl = Nothing
End Function
Enjoy ^^