I have a column with some stuff that looks like the following string: V2397(+60)
How do I get the value between the brackets? In this case the +60.
The number (and character) before the brackets is not something standardized and neither the number between the brackets (it can be 100, 10 -10 or even 0...).
VBA code:
cellValue = "V2397(+60)"
openingParen = instr(cellValue, "(")
closingParen = instr(cellValue, ")")
enclosedValue = mid(cellValue, openingParen+1, closingParen-openingParen-1)
Obviously cellValue should be read from the cell.
Alternatively, if cell A1 has one of these values, then the following formula can be used to extrcat the enclosed value to a different cell:
=Mid(A1, Find("(", A1)+1, Find(")",A1)-Find("(",A1)-1)
I would use a regular expression for this as it easily handles
a no match case
multiple matches in one string if required
more complex matches if your parsing needs evolve
The Test sub runs three sample string tests
The code below uses a UDF which you could call directly in Excel as well, ie = GetParen(A10)
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
Sub Test()
MsgBox GetParen("V2397(+60)")
MsgBox GetParen("Not me")
MsgBox GetParen(ActiveSheet.Range("A1"))
End Sub
Use InStr to get the index of the open bracket character and of the close bracket character; then use Mid to retrieve the desired substring.
Using InStr$ and Mid$ will perform better, if the parameters are not variants.
Thanks to Andrew Cooper for his answer.
For anyone interested I refactored into a function...
Private Function GetEnclosedValue(query As String, openingParen As String, closingParen As String) As String
Dim pos1 As Long
Dim pos2 As Long
pos1 = InStr(query, openingParen)
pos2 = InStr(query, closingParen)
GetEnclosedValue = Mid(query, (pos1 + 1), (pos2 - pos1) - 1)
End Function
To use
value = GetEnclosedValue("V2397(+60)", "(", ")" )
Related
I have this formula (below) where I am trying to find a space in C1. Instead of this, I would like to update this formula to look for anything except for "C" or any number and not only find a space.
LEFT(C1, find("" "", C1, 1)-1)
For e.g.
if C1 has - "C1234 - XXX" or "C1234-XXX" or "C1234:XXX", I always want the above function to find anything except for "C" and "1234" (i.e. numbers).
P.S.: I would want to use the find function only with improvements to meet the above conditions.
Please suggest.
Perhaps this:
'To create a new string from a source string which will or will not contain the characters present within the source string
'Examples of string of characters: 0123456789 -OR- {}[]<>\/|+*=-_(),.:;?!##$%^&™®©~'" OR - combination of various characters
Public Function getNewStringFromString(ByVal strSource As Variant, ByVal strChars As Variant, Optional isInString As Boolean = True) As String
Dim strArr As Variant, iChar As Variant
getNewStringFromString = ""
If VarType(strSource) = vbString And VarType(strChars) = vbString Then
strSource = Trim(strSource): strChars = Trim(strChars)
If Len(strSource) > 0 And Len(strChars) > 0 Then
strArr = Split(StrConv(strSource, vbUnicode), vbNullChar)
For Each iChar In strArr
If (isInString Xor isInArray(iChar, strChars)) = False Then getNewStringFromString = getNewStringFromString + iChar
Next iChar
Erase strArr
End If
End If
End Function
Use as the following:
MsgBox getNewStringFromString(CStr(Range("C1")), "C0123456789")
Forgot to give you the code for the isInArray function. Here it is:
'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))
Err.Clear: On Error GoTo 0
End If
End Function
Given your data format, where
C is always the first character
subsequent values are all digits
You want to return the C followed by the digits
Try:
="C" & LOOKUP(9E+307,VALUE(MID(A1,2,{1,2,3,4,5,6,7})))
If there might be more than 7 digits, you can either extend the array constant, or use a formula to create a larger array.
The formula looks for the largest integer in the string, starting with position 2. So it will stop at the last non-digit, since anything including a non-digit will return an error.
If the "non-digit" might be your decimal or thousands separator, you will need to replace it with something else, with a nested SUBSTITUTE
Replace . , and space with -
=LOOKUP(1E+307,--SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(MID(A1,2,{1,2,3,4,5,6,7}),",","-"),".","-"),".","-"))
For a VBA solution, I would use regular expressions.
Option Explicit
Function getCnum(str As String)
Dim RE As Object
Const sPat As String = "(^C\d+).*"
Set RE = CreateObject("vbscript.regexp")
With RE
.Global = False
.MultiLine = True
.ignorecase = True
.Pattern = sPat
getCnum = .Replace(str, "$1")
End With
End Function
Note that this also validates the string by checking that the first letter is, in fact, a C (or c). If you want it to be case-sensitive, make the obvious change.
My requirement is that I need to check whether a string variable has first character "P" followed by digits.
For example
P0
P123
P22
To-date I have looked at options for using Like as per here.
You could use a simple RegExp:
Function strOut(strIn As String) As String
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
.Pattern = "^P\d+$"
strOut = .Test(strIn)
End With
End Function
test code
Sub Test()
Debug.Print strOut("P22")
Debug.Print strOut("aP22")
Debug.Print strOut("P12344")
End Sub
You can also use the native Like operator:
Sub Foo()
Dim x As String, matches As Boolean
x = "P123"
matches = (x Like "P" & Application.Rept("[0-9]", Len(x) - 1))
Debug.Print matches
End Sub
(mystr Like "P#") or (mystr Like "P##") or (mystr Like "P###")
is probably the fastest solution, and the simplest one.
mystr like left("P######", len(mystr))
could work as well, and be more generic.
Anyway, if this is to be used in a query, a generic LIKE should be much more efficient than any VBA function.
my 0.02 cents
Sub Foo2()
x = "P0123"
Debug.Print IsNumeric(Replace(x, "P", "",,1))
End Sub
I am trying to remove words appearing in one string from a different string using a custom function. For instance:
A1:
the was why blue hat
A2:
the stranger wanted to know why his blue hat was turning orange
The ideal outcome in this example would be:
A3:
stranger wanted to know his turning orange
I need to have the cells in reference open to change so that they can be used in different situations.
The function will be used in a cell as:
=WORDREMOVE("cell with words needing remove", "cell with list of words being removed")
I have a list of 20,000 rows and have managed to find a custom function that can remove duplicate words (below) and thought there may be a way to manipulate it to accomplish this task.
Function REMOVEDUPEWORDS(txt As String, Optional delim As String = " ") As String
Dim x
'Updateby20140924
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For Each x In Split(txt, delim)
If Trim(x) <> "" And Not .exists(Trim(x)) Then .Add Trim(x), Nothing
Next
If .Count > 0 Then REMOVEDUPEWORDS = Join(.keys, delim)
End With
End Function
If you can guarantee that your words in both strings will be separated by spaces (no comma, ellipses, etc), you could just Split() both strings then Filter() out the words:
Function WORDREMOVE(ByVal strText As String, strRemove As String) As String
Dim a, w
a = Split(strText) ' Start with all words in an array
For Each w In Split(strRemove)
a = Filter(a, w, False, vbTextCompare) ' Remove every word found
Next
WORDREMOVE = Join(a, " ") ' Recreate the string
End Function
You can also do this using Regular Expressions in VBA. The version below is case insensitive and assumes all words are separated only by space. If there is other punctuation, more examples would aid in crafting an appropriate solution:
Option Explicit
Function WordRemove(Str As String, RemoveWords As String) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.ignorecase = True
.Global = True
.Pattern = "(?:" & Join(Split(WorksheetFunction.Trim(RemoveWords)), "|") & ")\s*"
WordRemove = .Replace(Str, "")
End With
End Function
My example is certainly not the best code, but it should work
Function WORDREMOVE(FirstCell As String, SecondCell As String)
Dim FirstArgument As Variant, SecondArgument As Variant
Dim FirstArgumentCounter As Integer, SecondArgumentCounter As Integer
Dim Checker As Boolean
WORDREMOVE = ""
FirstArgument = Split(FirstCell, " ")
SecondArgument = Split(SecondCell, " ")
For SecondArgumentCounter = 0 To UBound(SecondArgument)
Checker = False
For FirstArgumentCounter = 0 To UBound(FirstArgument)
If SecondArgument(SecondArgumentCounter) = FirstArgument(FirstArgumentCounter) Then
Checker = True
End If
Next FirstArgumentCounter
If Checker = False Then WORDREMOVE = WORDREMOVE & SecondArgument(SecondArgumentCounter) & " "
Next SecondArgumentCounter
WORDREMOVE = Left(WORDREMOVE, Len(WORDREMOVE) - 1)
End Function
Let's assume that we have one module with only one Sub in it, and there are no comments. How to identify all variable names ? Is it possible to identify names of variables which are not defined using Dim ? I would like to identify them and replace each with some random name to obfuscate my code (O0011011010100101 for example), replace part is much easier.
List of characters which could be use in names of macros, functions and variables :
ABCDEFGHIJKLMNOPQRSTUVWXYZdefghijklmnopqrstuvwxyzg€‚„…†‡‰Š‹ŚŤŽŹ‘’“”•–—™š›śťžź ˇ˘Ł¤Ą¦§¨©Ş«¬®Ż°±˛ł´µ¶·¸ąş»Ľ˝ľżŔÁÂĂÄĹĆÇČÉĘËĚÍÎĎĐŃŇÓÔŐÖ×ŘŮÚŰÜÝŢßŕáâăäĺćçčéęëěíîďđńňóôőö÷řůúűüýţ˙ÉĘËĚÍÎĎĐŃŇÓÔŐÖ×ŘŮÚŰÜÝŢßŕáâăäĺćçčéęëěíîďđńňóôőö÷řůúűüýţ˙
Below are my function I've wrote recenlty :
Function randomName(n as integer) as string
y="O"
For i = 2 To n:
If Rnd() > 0.5 Then
y = y & "0"
Else
y = y & "1"
End If
Next i
randomName=y
End Function
In goal to replace given strings in another string which represent the code of module I use below sub :
Sub substituteNames()
'count lines in "Module1" which is part of current workbook
linesCount = ActiveWorkbook.VBProject.VBComponents("Module1").CodeModule.CountOfLines
'read code from module
code = ActiveWorkbook.VBProject.VBComponents("Module1").CodeModule.Lines(StartLine:=1, Count:=linesCount)
inputStr = Array("name1", "name2", "name2") 'some hardwritten array with string to replace
namesLength = 20 'length of new variables names
For i = LBound(inputStr) To UBound(inputStr)
outputString = randomName(namesLength-1)
code = Replace(code, inputStr(i), outputString)
Next i
Debug.Print code 'view code
End Sub
then we simply substitute old code with new one, but how to identify strings with names of variables ?
Edition
Using **Option Explicit ** decrease safety of my simple method of obfuscation, because to reverse changes you only have to follow Dim statements and replace ugly names with something normal. Except that to make such substitution harder, I think it's good idea to break the line in the middle of variable name :
O0O000O0OO0O0000 _
0O00000O0OO0
the simple method is also replacing some strings with chains based on chr functions chr(104)&chr(101)&chr(108)&chr(108)&chr(111) :
Sub stringIntoChrChain()
strInput = "hello"
strOutput = ""
For i = 1 To Len(strInput)
strOutput = strOutput & "chr(" & Asc(Mid(strInput, i, 1)) & ")&"
Next i
Debug.Print Mid(strOutput, 1, Len(strOutput) - 1)
End Sub
comments like below could make impression on user and make him think that he does not poses right tool to deal with macro etc.:
'(k=Äó¬)w}ż^¦ů‡ÜOyúm=ěËnóÚŽb W™ÄQó’ (—*-ĹTIäb
'R“ąNPÔKZMţ†üÍQ‡
'y6ű˛Š˛ŁŽ¬=iýQ|˛^˙ ‡ńb ¬ĂÇr'ń‡e˘źäžŇ/âéç;1qýěĂj$&E!V?¶ßšÍ´cĆ$Âű׺Ůî’ﲦŔ?TáÄu[nG¦•¸î»éüĽ˙xVPĚ.|
'ÖĚ/łó®Üă9Ę]ż/ĹÍT¶Mµę¶mÍ
'q[—qëýY~Pc©=jÍ8˘‡,Ú+ń8ŐűŻEüńWü1ďëDZ†ć}ęńwŠbŢ,>ó’Űçµ™Š_…qÝăt±+‡ĽČgřÍ!·eŠP âńđ:ŶOážű?őë®ÁšńýĎáËTbž}|Ö…ăË[®™
You can use a regular expression to find variable assignments by looking for the equals sign. You'll need to add a reference to the Microsoft VBScript Regular Expressions 5.5 and Microsoft Visual Basic for Applications Extensibility 5.3 libraries as I've used early binding.
Please be sure to back up your work and test this before using it. I could have gotten the regex wrong.
UPDATE:
I've refined the regular expressions so that it no longer catches datatypes of strongly typed constants (Const ImAConstant As String = "Oh Noes!" previously returned String). I've also added another regex to return those constants as well. The last version of the regex also mistakenly caught things like .Global = true. That was corrected. The code below should return all variable and constant names for a given code module. The regular expressions still aren't perfect, as you'll note that I was unable to stop false positives on double quotes. Also, my array handling could be done better.
Sub printVars()
Dim linesCount As Long
Dim code As String
Dim vbPrj As VBIDE.VBProject
Dim codeMod As VBIDE.CodeModule
Dim regex As VBScript_RegExp_55.RegExp
Dim m As VBScript_RegExp_55.match
Dim matches As VBScript_RegExp_55.MatchCollection
Dim i As Long
Dim j As Long
Dim isInDatatypes As Boolean
Dim isInVariables As Boolean
Dim datatypes() As String
Dim variables() As String
Set vbPrj = VBE.ActiveVBProject
Set codeMod = vbPrj.VBComponents("Module1").CodeModule
code = codeMod.Lines(1, codeMod.CountOfLines)
Set regex = New RegExp
With regex
.Global = True ' match all instances
.IgnoreCase = True
.MultiLine = True ' "code" var contains multiple lines
.Pattern = "(\sAs\s)([\w]*)(?=\s)" ' get list of datatypes we've used
' match any whole word after the word " As "
Set matches = .Execute(code)
End With
ReDim datatypes(matches.count - 1)
For i = 0 To matches.count - 1
datatypes(i) = matches(i).SubMatches(1) ' return second submatch so we don't get the word " As " in our array
Next i
With regex
.Pattern = "(\s)([^\.\s][\w]*)(?=\s\=)" ' list of variables
' begins with a space; next character is not a period (handles "with" assignments) or space; any alphanumeric character; repeat until... space
Set matches = .Execute(code)
End With
ReDim variables(matches.count - 1)
For i = 0 To matches.count - 1
isInDatatypes = False
isInVariables = False
' check to see if current match is a datatype
For j = LBound(datatypes) To UBound(datatypes)
If matches(i).SubMatches(1) = datatypes(j) Then
isInDatatypes = True
Exit For
End If
'Debug.Print matches(i).SubMatches(1)
Next j
' check to see if we already have this variable
For j = LBound(variables) To i
If matches(i).SubMatches(1) = variables(j) Then
isInVariables = True
Exit For
End If
Next j
' add to variables array
If Not isInDatatypes And Not isInVariables Then
variables(i) = matches(i).SubMatches(1)
End If
Next i
With regex
.Pattern = "(\sConst\s)(.*)(?=\sAs\s)" 'strongly typed constants
' match anything between the words " Const " and " As "
Set matches = .Execute(code)
End With
For i = 0 To matches.count - 1
'add one slot to end of array
j = UBound(variables) + 1
ReDim Preserve variables(j)
variables(j) = matches(i).SubMatches(1) ' again, return the second submatch
Next i
' print variables to immediate window
For i = LBound(variables) To UBound(variables)
If variables(i) <> "" And variables(i) <> Chr(34) Then ' for the life of me I just can't get the regex to not match doublequotes
Debug.Print variables(i)
End If
Next i
End Sub
I've been trawling through page after page on Google and here looking for a solution to this seemingly simple request, but to no avail. Does anyone know a reliable way to convert a string to sentence case using vba?
Ideally I would build it into a sub rather than a function, so it is easier to call from the GUI.
For reference, I would want:
HERE IS A LONG, UGLY UPPERCASE SENTENCE. PLEASE AMEND ME IMMEDIATELY.
to become:
Here is a long, ugly uppercase sentence. Please amend me immediately.
Converting to Title Case I found extremely simple (as there's a built-in function for that) but converting to sentence case has proven really difficult indeed.
I have tried some of the following methods but come up with errors at every turn:
http://www.vbforums.com/showthread.php?t=536912
http://vbamacros.blogspot.com/2007/09/sentence-case.html
How can I get this to work?
You could use a RegExp to more efficiently run the parsing
Something like this
Sub Tested()
Call ProperCaps("HERE IS A LONG, UGLY UPPERCASE SENTENCE. PLEASE AMEND ME IMMEDIATELY." & vbCrLf & "next line! now")
End Sub
Function ProperCaps(strIn As String) As String
Dim objRegex As Object
Dim objRegMC As Object
Dim objRegM As Object
Set objRegex = CreateObject("vbscript.regexp")
strIn = LCase$(strIn)
With objRegex
.Global = True
.ignoreCase = True
.Pattern = "(^|[\.\?\!\r\t]\s?)([a-z])"
If .test(strIn) Then
Set objRegMC = .Execute(strIn)
For Each objRegM In objRegMC
Mid$(strIn, objRegM.firstindex + 1, objRegM.Length) = UCase$(objRegM)
Next
End If
MsgBox strIn
End With
End Function
Thanks for this, useful bit of code. Why VB has proper case and not sentence case is very strange. I have tweaked it for my purpose, as the original won't capitalise the first letter if there is a space in front of it, hope you don't mind me sharing my few changes.
To remove any unwanted spaces at the start or end of the sentence, I have added another function that is called from the above.
Public Function DblTrim(vString As String) As String
Dim tempString As String
tempString = vString
Do Until Left(tempString, 1) <> " "
tempString = LTrim(tempString)
Loop
Do Until Right(tempString, 1) <> " "
tempString = RTrim(tempString)
Loop
DblTrim = tempString
End Function
Public Function ProperCaps(strIn As String) As String
Dim objRegex As Object
Dim objRegMC As Object
Dim objRegM As Object
Set objRegex = CreateObject("vbscript.regexp")
strIn = DblTrim(strIn)
strIn = LCase$(strIn)
With objRegex
.Global = True
.ignoreCase = True
.Pattern = "(^|[\.\?\!\r\t]\s?)([a-z])"
If .test(strIn) Then
Set objRegMC = .Execute(strIn)
For Each objRegM In objRegMC
Mid$(strIn, objRegM.firstindex + 1, objRegM.Length) = UCase$(objRegM)
Next
End If
ProperCaps = strIn
End With
End Function
You can call ProperCaps(Yourstring) to get the sentence back with the first letter as a capital, with all spaces removed.
You can also use DblTrim(Yourstring) to remove all spaces at the front and back of the string (without altering the sentence case), regardless of how many spaces there are.
I know it is an old post, just a short code using built-in functions for someone may refer to (it is self explanatory).
To remove extra spaces, wrap the entire text with trim function if needed.
Public Function SentenceCase(Text As String) As String
SentenceCase = UCase(Mid(Text, 1, 1)) & LCase(Mid(Text, 2))
End Function