I have a string
Dim A As String
A = "A23"
B = "bd4"
I need to get only the numeric values as the output as below
A = 23
B = 4
You could use a regex replacement here:
Dim A As String: A = "A23"
Dim AOut As String
Dim pattern As String: pattern = "\D+"
Set regEx = CreateObject("VBScript.RegExp")
With regEx
.Global = True
.Pattern = pattern
End With
AOut = regEx.Replace(A, "")
Debug.Print AOut
Dim A As String
A = "bd4"
number_val = Range(A).Row
MsgBox (number_val)
We can use range function, this gives the numeric from the string.
Related
The following sub accepts a word.range as argument and formats it's text bold when embraced into double asterics **
Private Sub parse(parseRange As Word.Range)
'technical range for starting double asterics
Dim workRange As Word.Range
'range for enclosing doulbe asterics
Dim workRange2 As Word.Range
'another range for a bold text
Dim workRange3 As Word.Range
'flag variable
Dim isSelect As Boolean
'number of iterated character in parseRange
Dim char
'I set my ranges through parseRange, otherwise I get "object variable not set" error
Set workRange = parseRange
Set workRange2 = parseRange
Set workRange3 = parseRange
char = 2
isSelect = False
Do While char <= parseRange.Characters.Count
If parseRange.Characters(char) = "*" And parseRange.Characters(char - 1) = "*" Then
Select Case isSelect
Case False
isSelect = True
workRange.Start = parseRange.Start + char - 2
'at this line the initial parseRange.characters.count is set to 2 and all the following code fails as a result.
workRange.End = parseRange.Start + char
workRange.Text = ""
Case True
isSelect = False
workRange2.Start = parseRange.Start + char - 2
workRange2.End = parseRange.Start + char
workRange2.Text = ""
workRange3.SetRange Start:=workRange.End, _
End:=workRange2.Start
workRange3.End = workRange2.Start
workRange3.Bold = True
End Select
End If
char = char + 1
Loop
End Sub
As I understand, because I defined workRange/2/3 through parseRange, the changes in these ranges are now affecting the original. How can I avoid such mistake?
The Word object model includes a Duplicate method for the Range object. This enables you to work with a copy of the range without affecting the start and end points of the original. Is that what you want?
Set workRange = parseRange.Duplicate
Set workRange2 = parseRange.Duplicate
Set workRange3 = parseRange.Duplicate
I want to remove blank lines in a string as follows:
"First section
Second section
Third section"
I display a rolling index on every content slide so as you click through the slides, the index highlights the section you are in. I don't want to display subsections, so I tried to replace section names starting with "-" with "", but that means I have blank lines. So now I want to remove the blank lines.
I tried:
IIF statements but replacing with "" doesn't remove a blank line
Regular expressions, another link suggested the following pattern would work: #"^\s+$[\r\n]*" but the # throws up an error and it doesn't work in any case
I tried something like the below:
Dim RE As Object
Set RE = CreateObject("VBScript.RegExp")
With RE
.Multiline = True
.Global = True
resultString = .Replace(subjectString, "\s\n", string.empty)
MsgBox resultString
End With
Another potential solution I found on stackoverflow.
Dim xArr() as string
xArr = Split(TextBox1.Value, vbCrLf)
TextBox1.Value = ""
for i = 0 to Ubound(xArr)
If Trim(xArr(i)) <> "" Then
TextBox1.value = TextBox1.value & xArr(i) & vbCrLf
End If
Next
Looks like your RegEx code is actually intended for VB.Net rather than VBA, the code below replaces n blank lines with 1 in VBA.
Dim RE As Object: Set RE = CreateObject("VBScript.RegExp")
With RE
.MultiLine = True
.Global = True
.Pattern = "(\r\n)+"
resultString = .Replace(subjectString, vbCrLf)
MsgBox resultString
End With
Of course if you only ever have 2 blank lines you can simply:
resultString = replace$(subjectString, vbcrlf & vbcrlf, vbcrlf)
I know this is old but here's a regex Public Function i made to help. Theres probably a better way but this was simple for me and worked.
'=================================================================================='
Public Function RegExReplace(TextContent As String, SearchEx As String, Optional ReplaceEx As String = "", Optional _
EmptyLines As Boolean = False, Optional TrimLines As Boolean = True) As String
Dim regEx As Object, strOutput As String
Set regEx = CreateObject("vbscript.regexp")
With regEx: .Global = True: .IgnoreCase = False: .MultiLine = True: .Pattern = SearchEx: End With
TextContent = regEx.Replace(TextContent, ReplaceEx)
If EmptyLines = False Then TextContent = RegExReplace(TextContent, "\r\n\r\n", "", True, False)
If TrimLines = True Then TextContent = Trim(TextContent)
RegExReplace = TextContent: Set regEx = Nothing
End Function
'=================================================================================='
If for whatever reason you'd prefer to avoid using RegEx (working on a Mac where VBScript isn't available for example), here's a purely VB approach:
Sub Test()
Call TakeOutTheEmpties(ActiveWindow.Selection.ShapeRange(1))
End Sub
Sub TakeOutTheEmpties(oSh As Shape)
Dim oPara As TextRange
Dim x As Long
If oSh.HasTextFrame Then
If oSh.TextFrame.HasText Then
For x = oSh.TextFrame.TextRange.Paragraphs.Count To 1 Step -1
Set oPara = oSh.TextFrame.TextRange.Paragraphs(x)
If oPara.Text = vbCr Then
oPara.Delete
End If
Next
End If
End If
End Sub
The code from Get the value between the brackets works well if the cell contains just one "(text)".
Unfortunately, in my rows there are many "Sample (sample1) (sample2)" format sentences and I need the last part.
Function GetParen(strIn As String) As String
Dim objRegex As Object
Dim objRegMC As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Pattern = "\((.+?)\)"
If .Test(strIn) Then
Set objRegMC = .Execute(strIn)
GetParen = objRegMC(0).submatches(0)
Else
GetParen = "No match"
End If
End With
Set objRegex = Nothing
End Function
Could somebody help me to modify the code? Because if the cell contains "Text (text part1) (text part2)" The result what I get is "text part1" but I need the "text part2".
Thanks.
Why bother with regex ?? Consider the alternative:
Public Function GetParen(strIn As String) As String
Dim gather As Boolean, L As Long, i As Long
Dim CH As String
gather = False
L = Len(strIn)
For i = L To 1 Step -1
CH = Mid(strIn, i, 1)
If gather Then GetParen = CH & GetParen
If CH = ")" Then gather = True
If CH = "(" Then Exit For
Next i
GetParen = Mid(GetParen, 2)
End Function
EDIT#1:
Simpler:
Public Function GetParen2(strIn As String) As String
ary = Split(strIn, "(")
bry = Split(ary(UBound(ary)), ")")
GetParen2 = bry(0)
End Function
tiborjan:
I have a function that I wrote for just that reason. Here it is:
Function SubStr(s1 As String, sLeft As String, sL_Occ As Integer, sRight As String, sR_Occ As Integer) As String
'Cuts a piece of text from between two strings within another string
Dim LeftBound As Integer, RightBound As Integer, i As Integer
If sLeft = "Minimum" Then
LeftBound = 0
Else
For i = 1 To sL_Occ
LeftBound = InStr(LeftBound + 1, s1, sLeft, vbTextCompare)
Next i
End If
LeftBound = LeftBound + Len(sLeft) - 1 'measure from the right of the left bound
If sRight = "Maximum" Then
RightBound = Len(s1) + 1
Else
For i = 1 To sR_Occ
RightBound = InStr(RightBound + 1, s1, sRight, vbTextCompare)
Next i
End If
SubStr = Mid(s1, LeftBound + 1, RightBound - LeftBound - 1)
End Function
It has 5 parameters:
s1: the string that contains the text you want to parse
sLeft: the left-bound of the text you want to parse. Use "(" for your application.
sL_Occ: iteration number of sLeft. So if you wanted the second "(" that appears in s1, make this 2.
sRight: same as sLeft, but the right-bound.
sR_Occ: same as sL_Occ, but referring to the right-bound.
To make it easy: use this function code instead of yours. If you want to pull text from the second set of parentheses, use
s1 = "(P1) (P2) (P3) (P4)"
sLeft = "("
sL_Occ = 2
sRight = ")"
sR_Occ = 2
The return in the above would be "P2".
Hope that helps!
Matt, via ExcelArchitect.com
or how about simply
Function LastParam(ByVal str As String) As String
Dim arr() As String
arr = Split(str, "(")
LastParam = Split(arr(UBound(arr, 1)), ")")(0)
End Function
For completeness, you would only need minor changes to your code to make it work with your regex.
Set the Global flag to True, and return the last match from the match collection.
Function GetParen(strIn As String) As String
Dim objRegex As Object
Dim objRegMC As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Global = True
.Pattern = "\((.+?)\)"
If .Test(strIn) Then
Set objRegMC = .Execute(strIn)
GetParen = objRegMC(objRegMC.Count - 1).submatches(0)
Else
GetParen = "No match"
End If
End With
Set objRegex = Nothing
End Function
A minor tweak to my earlier Regexpwill extract the last match.
test
Sub Test()
MsgBox GetParen("(Sample (sample1) (sample2)")
End Sub
code
Function GetParen(strIn As String) As String
Dim objRegex As Object
Dim objRegMC As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Pattern = "\((.+?)\)"
.Global = True
If .Test(strIn) Then
Set objRegMC = .Execute(strIn)
GetParen = objRegMC(objRegMC.Count - 1).submatches(0)
Else
GetParen = "No match"
End If
End With
Set objRegex = Nothing
End Function
this script is going to extract each text between () from whole string. Now i would prepare it as a function because many string will be taking under that then i would like to add each extracted words inside table/or list. Each of extracted texts between () should be without special characters which sometimes could occur inside text and i would like to cut them of the string (i would like only to stay A-Z a-z 0-9 how could i do it all?
Sub Main()
Dim s$
s = "hsus(irt)bla dsd (got)(rifk)"
Debug.Print extract_value(s)
End Sub
Public Function extract_value$(s$)
Dim returnS$
Dim v
v = Split(s, Chr(40))
For Each Item In v
If InStr(Item, Chr(41)) Then
returnS = returnS & Chr(32) & Split(Item, ")")(0)
End If
Next
extract_value = Trim$(returnS)
End Function
When parsing you can use a helper function to check for just letters and numbers using the ASCII encoding.
Function validChr(chr As String) as Boolean
Dim ascCode As Integer
ascCode = Asc(chr)
If ascCode >= 65 And ascCode <= 90 Then 'Uppercase
validChr = True
ElseIf ascCode >= 97 And ascCode <= 122 Then 'Lowercase
validChr = True
ElseIf ascCode >= 48 And ascCode <= 57 Then 'Numbers
validChr = True
Else
validChr = False
End Function
You can also look at using RegEx.
This two stage `Regexp`
Converts hsus(ir%$%^t)bla dsd (g°ot)(rifk) to ir%$%^t g°ot rifk
In a single shot ir%$%^t g°ot rifkto irt got rifk
test sub
Sub Main()
Dim strTest As String
strTest = "hsus(ir%$%^t)bla dsd (g°ot)(rifk)"
MsgBox GrabIt(strTest)
End Sub
main sub
Function GrabIt(strIn As String) As String
Dim objRegex As Object
Dim objRegMC As Object
Dim objRegM As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Pattern = "\((.*?)\)"
.Global = True
If .test(strIn) Then
Set objRegMC = .Execute(strIn)
For Each objRegM In objRegMC
GrabIt = GrabIt & Chr(32) & objRegM.submatches(0)
Next
End If
.Pattern = "[^\w|\s]+"
GrabIt = .Replace(GrabIt, vbNullString)
End With
End Function
I have a lot of cells that contain some numbers and other non-relevant characters. For example cell may look like: 65f or as 11,345asd.
My goal is to delete everything but numbers in these cells, so I could use these numbers for further calculations. I have found a lot of similar questions on different sites, but they are quite specific and I still don't understand how to do it properly.
So the question is how to use change cells or maybe even a range of cells depending on contents? I have some ideas how to do it using string function Replace. But nothing that looks good.
Thanks!
Another way using RegExp
Adding Reference
Add a reference to Microsoft VBScript Regular Expressions 5.5. See image below
CODE: Paste this in a module
Option Explicit
Function GetNumbers(rng As Range) As Variant
Dim StrSample As String
Dim myRegExp As RegExp
Dim myMatches As MatchCollection
Dim myMatch As Match
StrSample = rng.Value
Set myRegExp = New RegExp
With myRegExp
.Pattern = "[^0-9]"
.IgnoreCase = True
.Global = True
End With
Set myMatches = myRegExp.Execute(StrSample)
For Each myMatch In myMatches
Debug.Print myMatch.Value
StrSample = Replace(StrSample, myMatch.Value, "")
Next
GetNumbers = StrSample
End Function
SCREENSHOT:
EDIT
Here is a shorter version which doesn't use looping at all.
Function GetNumbers(rng As Range) As Variant
Dim myRegExp As RegExp
Set myRegExp = New RegExp
myRegExp.Pattern = "[^0-9]"
myRegExp.Global = True
GetNumbers = myRegExp.Replace(rng.Value, "")
End Function
A wee function
public function TONUM(str As string) As string
dim i As long
for i = 1 To len(str)
if not mid$(str, i, 1) Like "[0-9]" then mid$(str, i, 1) = "?"
next
TONUM = replace$(str, "?", "")
end function