I made the following script and I have a problem, the two first replace are working but not the replace in the if.
I tried a lot of different ways but it's still not working
Do you know why ?
Private Sub CommandButton1_Click()
Dim totalCases As Integer
totalCases = Range("Q1").End(xlDown).Row
For caseNb = 2 To totalCases Step 1
replace_me_that caseNb, 17
Next caseNb
For caseNb = 2 To totalCases Step 1
replace_me_that caseNb, 18
Next caseNb
End Sub
Private Sub replace_me_that(ByVal caseNb As Integer, ByVal column As Integer)
Dim val As String
Dim objRegExp As Object
If (Cells(caseNb, column).Value = "") Then
Exit Sub
End If
val = Cells(caseNb, column).Value
Set objRegExp = CreateObject("VBScript.RegExp")
With objRegExp
.Global = True
.IgnoreCase = True
End With
objRegExp.Pattern = "\s*\(0\)\s*|\s*[()]\s*"
val = objRegExp.Replace(val, "")
val = Replace(val, ".", "") =>work
val = Replace(val, " ", "") =>work
If (Left(val, 2) = "33") Then =>condition true
val = Replace(val, "33", "+33", 1) =>don't work
End If
Cells(caseNb, column).Value = val
End Sub
My best guess would be that either the 33 contained in the cell is seen as an integer or it is possible that you need to set the last option to "vbcomparetext". I usually use that option whenver I am comparing strings and it works well for me usually. Good Luck.
I found the error, each cell was formatted as integer instead of text. It's working now
Related
I have a button and I pass String as parameter. If string parameter increase more that 255 characters, it doesn't get any value. If string parameter is less than 255 characters, it is working fine.
Here is my code:
Dim parameterText As String
parameterText = "First Parameter Value | Third Parameter Value | Third Parameter Value"
Dim AdviceItem As CommandBarButton
Set AdviceItem = CategoryItem.Controls.Add(msoControlButton, , , , True)
With AdviceItem
.Caption = adviceText
.Visible = True
.Parameter = strParameter
.OnAction = "myFunction"
End With
Sub myFunction()
Dim parameters() As String
ReDim parameters(3)
Dim parameterText As String
parameterText = Application.CommandBars.ActionControl.Parameter
'parameterText is blank if there are more than 255 characters passed from above function
MsgBox ("parameterText" & parameterText)
parameters() = Split(parameterText, "|")
End Sub
Can anybody suggest me how to achieve it?
Assuming that there is a limitation on the .parameter, you can bypass this by using an array to store the string you want to display.
Option Explicit
Public AllParameters(100) As String
Public AllAdviceTexts(100) as String
Sub defineParameters()
AllParameters(0) = "First Parameter Value"
AllParameters(1) = "Third Parameter Value "
AllParameters(2) = "Third Parameter Value "
'etc
'set advice texts here too
End Sub
Private Sub Workbook_Open()
Dim AdviceItem As CommandBarButton
Dim i As Integer
Call defineParameters
For i = 0 To 100
Set AdviceItem = CategoryItem.Controls.Add(msoControlButton, , , , True)
With AdviceItem
.Caption = AllAdviceTexts(i)
.Visible = True
.Parameter = i
.OnAction = "myFunction"
End With
Next i
End Sub
Sub myFunction()
Dim parameterText As String
Dim index As Integer
index = Application.CommandBars.ActionControl.Parameter
parameterText = AllParameters(index)
MsgBox ("parameterText" & parameterText)
End Sub
No its not. VB string type can hold data more than 255 character.
A variable-length string can contain up to approximately 2 billion (2^31) characters
A fixed-length string can contain 1 to approximately 64K (2^16) characters.
and for SPLIT you can try like below
Dim LString As String
Dim LArray() As String
LString = "foobar.com"
LArray = Split(LString, ".")
MsgBox LArray(0)
MsgBox LArray(1)
Note: https://msdn.microsoft.com/en-us/library/6x627e5f(v=vs.90).aspx
Try to use below code if you get some idea.
Function Over255()
Dim myArray(3) As String '<<<<< not variant
myArray(0) = String(300, "a")
myArray(1) = String(300, "b")
myArray(2) = String(300, "c")
myArray(3) = String(300, "d")
'Over255 = Application.Transpose(myArray())
Over255 = TR(myArray)
End Function
'like Application.Transpose...
Function TR(arrIn) As String()
Dim arrOut() As String, r As Long, ln As Long, i As Long
ln = (UBound(arrIn) - LBound(arrIn)) + 1
ReDim arrOut(1 To ln, 1 To 1)
i = 1
For r = LBound(arrIn) To UBound(arrIn)
arrOut(i, 1) = arrIn(r)
i = i + 1
Next r
TR = arrOut
End Function
All,
I have an Excel spreadsheet which gathers files from various locations which have version numbers at the end of their name.
eg
Filea_v1.1.xlsm
Filea_v1.1.1.xlsm
Filea_v9.1.xlsm
Filea_v11.1.1.xlsm
I have already stripped the details of the file and left with the version number, but I'm finding it hard to code to get the latest version. When using a simple
If LatestVersion > LatestVersion_Last
' 11.1.1 > 9.1
I get a FALSE output as it thinks the 9.1 is greater than 11.1.1 (as its held in a string). I can't convert to a number that I'm aware of as it contains more than one decimal place.
Does anyone have any suggestions?
Thanks
This function returns 1 if the version of the first input string is bigger, -1 if the second one is bigger and 0 if both are equal:
Function Compare(a As String, b As String) As Integer
Dim n As Integer
Dim aarr() As String
Dim barr() As String
Dim av As Integer
Dim bv As Integer
aarr = Split(a, ".")
barr = Split(b, ".")
n = LBound(aarr)
Do
av = -1
If UBound(aarr) > i - 1 Then av = CInt(aarr(i))
bv = -1
If UBound(barr) > i - 1 Then bv = CInt(barr(i))
If av = -1 And bv = -1 Then
Compare = 0
Exit Function
End If
If av > bv Then
Compare = 1
Exit Function
End If
If av < bv Then
Compare = -1
Exit Function
End If
i = i + 1
Loop
End Function
Public Fucntion CompareVersion( strVersion1 as String, strVersion2 as String)
strVersion1 = "Filea_v11.1.1.xlsm"
strVersion2 = "Filea_v9.1.xlsm"
strVersion1 = Replace(strVersion1, "Filea_v", "") 'remove prefix
strVersion1 = Replace(strVersion1, ".xlsm", "") ' remove suffix
strVersion1 = Replace(strVersion1, ".", "") 'remove dots
strVersion2 = Replace(strVersion1, "Filea_v", "") 'remove prefix
strVersion2 = Replace(strVersion1, ".xlsm", "") ' remove suffix
strVersion2 = Replace(strVersion1, ".", "") 'remove dots
Dim strVersionArray1 as String()
Dim strVersionArray2 as String()
strVersionArray1 = Split(strVersion1,".")
strVersionArray2 = Split(strVersion2,".")
Dim i as Integer
For i=LBound(strVersionArray1) To UBound(strVersionArray2)
If (Cint(strVersionArray1(i))>Cint(strVersionArray2(i))) Then
'strVerion1 is greater than strVersion2
GoTo EXIT_FUNC:
Else If (Cint(strVersionArray1(i))<Cint(strVersionArray2(i))) Then
'strVerion is greater than strVersion2
GoTo EXIT_FUNC:
Else If (Cint(strVersionArray1(i))=Cint(strVersionArray2(i))) Then
'we need to examine the next segment of the array
End if
Next i
EXIT_FUNC:
End Function
I think you could try something like this:
Function FctLatest(ByVal LatestVersion As String, ByVal LatestVersion_Last As String) As Boolean
Dim comparedNew, comparedOld As String
'Loop to remove the versions one by one
Do
'For the new version
comparedNew = CutString(comparedNew, LatestVersion)
'For the previous version
comparedOld = CutString(comparedOld, LatestVersion_Last)
'we eliminate the case of equal versions
If CInt(comparedNew) > CInt(comparedOld) Then
FctLatest = True
GoTo endFunction
ElseIf CInt(comparedNew) < CInt(comparedOld) Then
FctLatest = False
GoTo endFunction
End If
Loop While InStr(LatestVersion_Last, ".") <> 0 Or InStr(LatestVersion, ".") <> 0
'For the new version
comparedNew = CutString(comparedNew, LatestVersion)
'For the previous version
comparedOld = CutString(comparedOld, LatestVersion_Last)
'we eliminate the case of equal versions, and choose the first one input
If CInt(comparedNew) > CInt(comparedOld) Then
FctLatest = True
ElseIf CInt(comparedNew) < CInt(comparedOld) Then
FctLatest = False
End If
endFunction:
End Function
Private Function CutString(ByVal ReturnedString, ByRef InputString As String) As String
'For latest version
If InStr(InputString, ".") = 0 Then
ReturnedString = InputString
Else
ReturnedString = Left(InputString, InStr(InputString, ".") - 1) 'Adding the first part of the version
InputString = Right(InputString, Len(InputString) - InStr(InputString, ".")) 'Removing the first part of the version
End If
CutString = ReturnedString
End Function
It returns a boolean comparing the versions you're interested in.
Regards,
Pierre.
Edit: just added cases, as it wasn't functional in the first place.
I have this function which returns as string the value in comma separated string which is in order of given integer value.
Private Sub TestGetNthNumber()
Debug.Print GetNthNumber("NUMBERS 5088, 5089, 5090, 5091", 2)
End Sub
Public Function GetNthNumber(sMark As String, iOrder As Integer) As String
Dim sTemp As String
Dim sNumber As String
Dim iLoop As Integer
If sMark = "" Then
Exit Function
End If
sTemp = sMark & ","
For iLoop = 1 To iOrder
sTemp = Mid(sTemp, InStr(sTemp, " "))
sNumber = Trim(Left(sTemp, InStr(sTemp, ",") - 1))
sTemp = Mid(sTemp, InStr(sTemp, ",") + 1)
Next
GetNthNumber = sNumber
End Function
The test Sub will return "5089" as its given number 2 in the list of values.
My question;
Is there better method to do this instead of the messy string manipulation with Mid, Left and InStr? Like a way to turn the comma separated string values into an array?
Another problem;
It is possible the string is in format "NUMBERS 5088, 5089, 5090 and 5091". But for this I assume simply replacing " and" with "," before handling it does the trick.
The other alternative is to use RegEx/RegExp. Your function will looks like that:
Public Function GetNthNumberAlternative(sMark As String, iOrder As Integer) As String
'regexp declaration
Dim objRegExp As Object
Set objRegExp = CreateObject("vbscript.regexp")
With objRegExp
.Global = True
.Pattern = "\d+"
GetNthNumberAlternative = .Execute(sMark)(iOrder - 1).Value
End With
End Function
And you could call it in this way:
Private Sub TestGetNthNumber()
Debug.Print GetNthNumberAlternative("NUMBERS 5088 AND 5089 OR 5090, 5091", 1)
End Sub
You want to use the Split function. If you have the same values each time then you can remove the NUMBERS and the final AND. Something like this:
Private Sub TestGetNthNumber()
Debug.Print GetNthNumber("NUMBERS 5088, 5089, 5090, 5091", 2)
End Sub
Public Function GetNthNumber(sMark As String, iOrder As Integer) As String
Dim vArray As Variant
sMark = Replace(sMark, "NUMBERS", "")
sMark = Replace(sMark, "AND", "")
vArray = Split(sMark, ",")
GetNthNumber = vArray(iOrder)
End Function
How to make a style as a bookmark in word 2010?
You won't be able to use most of the text in the document as the bookmark name. It is just illegal to use certain characters in a bookmark name in Word/VBA. It may be possible to add such characters in bookmark names in an XML format of the document, so if it is required, you can ask a separate question.
This feels like way too much code to post on SO. You really need to explain what framework you have in place and tell us where your hurdles are. We can't do this again. "Works for me". If you have any questions though don't hesitate to ask.
Run the "RunMe" macro at the bottom.
Private Function IsParagraphStyledWithHeading(para As Paragraph) As Boolean
Dim flag As Boolean: flag = False
If InStr(1, para.Style, "heading", vbTextCompare) > 0 Then
flag = True
End If
IsParagraphStyledWithHeading = flag
End Function
Private Function GetTextRangeOfStyledParagraph(para As Paragraph) As String
Dim textOfRange As String: textOfRange = para.Range.Text
GetTextRangeOfStyledParagraph = textOfRange
End Function
Private Function BookmarkNameAlreadyExist(bookmarkName As String) As Boolean
Dim bookmark As bookmark
Dim flag As Boolean: flag = False
For Each bookmark In ActiveDocument.Bookmarks
If bookmarkName = bookmark.name Then
flag = True
End If
Next
BookmarkNameAlreadyExist = flag
End Function
Private Function CreateUniqueBookmarkName(bookmarkName As String)
Dim uniqueBookmarkName As String
Dim guid As String: guid = Mid$(CreateObject("Scriptlet.TypeLib").guid, 2, 36)
guid = Replace(guid, "-", "", , , vbTextCompare)
uniqueBookmarkName = bookmarkName & guid
CreateUniqueBookmarkName = uniqueBookmarkName
End Function
Private Function BookmarkIt(rng As Range, bookmarkName As String)
Dim cleanName As String: cleanName = MakeValidBMName(bookmarkName)
If BookmarkNameAlreadyExist(cleanName) Then
cleanName = CreateUniqueBookmarkName(cleanName)
End If
ActiveDocument.Bookmarks.Add name:=cleanName, Range:=rng
End Function
''shamelessly stolen from gmaxey at http://www.vbaexpress.com/forum/showthread.php?t=37674
Private Function MakeValidBMName(strIn As String)
Dim pFirstChr As String
Dim i As Long
Dim tempStr As String
strIn = Trim(strIn)
pFirstChr = Left(strIn, 1)
If Not pFirstChr Like "[A-Za-z]" Then
strIn = "A_" & strIn
End If
For i = 1 To Len(strIn)
Select Case Asc(Mid$(strIn, i, 1))
Case 49 To 58, 65 To 90, 97 To 122
tempStr = tempStr & Mid$(strIn, i, 1)
Case Else
tempStr = tempStr & "_"
End Select
Next i
tempStr = Replace(tempStr, " ", " ")
MakeValidBMName = tempStr
End Function
Sub RunMe()
Dim para As Paragraph
Dim textOfPara As String
For Each para In ActiveDocument.Paragraphs
If IsParagraphStyledWithHeading(para) Then
textOfPara = GetTextRangeOfStyledParagraph(para)
If para.Range.Bookmarks.Count < 1 Then
BookmarkIt para.Range, textOfPara
End If
End If
Next
End Sub
I have string "ololo123".
I need get position of first digit - 1.
How to set mask of search ?
Here is a lightweight and fast method that avoids regex/reference additions, thus helping with overhead and transportability should that be an advantage.
Public Function GetNumLoc(xValue As String) As Integer
For GetNumLoc = 1 To Len(xValue)
If Mid(xValue, GetNumLoc, 1) Like "#" Then Exit Function
Next
GetNumLoc = 0
End Function
Something like this should do the trick for you:
Public Function GetPositionOfFirstNumericCharacter(ByVal s As String) As Integer
For i = 1 To Len(s)
Dim currentCharacter As String
currentCharacter = Mid(s, i, 1)
If IsNumeric(currentCharacter) = True Then
GetPositionOfFirstNumericCharacter = i
Exit Function
End If
Next i
End Function
You can then call it like this:
Dim iPosition as Integer
iPosition = GetPositionOfFirstNumericCharacter("ololo123")
Not sure on your environment, but this worked in Excel 2010
'Added reference for Microsoft VBScript Regular Expressions 5.5
Const myString As String = "ololo123"
Dim regex As New RegExp
Dim regmatch As MatchCollection
regex.Pattern = "\d"
Set regmatch = regex.Execute(myString)
MsgBox (regmatch.Item(0).FirstIndex) ' Outputs 5
I actually have that function:
Public Function GetNumericPosition(ByVal s As String) As Integer
Dim result As Integer
Dim i As Integer
Dim ii As Integer
result = -1
ii = Len(s)
For i = 1 To ii
If IsNumeric(Mid$(s, i, 1)) Then
result = i
Exit For
End If
Next
GetNumericPosition = result
End Function
You could try regex, and then you'd have two problems. My VBAfu is not up to snuff, but I'll give it a go:
Function FirstDigit(strData As String) As Integer
Dim RE As Object REMatches As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.Pattern = "[0-9]"
End With
Set REMatches = RE.Execute(strData)
FirstDigit = REMatches(0).FirstIndex
End Function
Then you just call it with FirstDigit("ololo123").
If speed is an issue, this will run a bit faster than Robs (noi Rob):
Public Sub Example()
Const myString As String = "ololo123"
Dim position As Long
position = GetFirstNumeric(myString)
If position > 0 Then
MsgBox "Found numeric at postion " & position & "."
Else
MsgBox "Numeric not found."
End If
End Sub
Public Function GetFirstNumeric(ByVal value As String) As Long
Dim i As Long
Dim bytValue() As Byte
Dim lngRtnVal As Long
bytValue = value
For i = 0 To UBound(bytValue) Step 2
Select Case bytValue(i)
Case vbKey0 To vbKey9
If bytValue(i + 1) = 0 Then
lngRtnVal = (i \ 2) + 1
Exit For
End If
End Select
Next
GetFirstNumeric = lngRtnVal
End Function
An improved version of spere's answer (can't edit his answer), which works for any pattern
Private Function GetNumLoc(textValue As String, pattern As String) As Integer
For GetNumLoc = 1 To (Len(textValue) - Len(pattern) + 1)
If Mid(textValue, GetNumLoc, Len(pattern)) Like pattern Then Exit Function
Next
GetNumLoc = 0
End Function
To get the pattern value you can use this:
Private Function GetTextByPattern(textValue As String, pattern As String) As String
Dim NumLoc As Integer
For NumLoc = 1 To (Len(textValue) - Len(pattern) + 1)
If Mid(textValue, NumLoc, Len(pattern)) Like pattern Then
GetTextByPattern = Mid(textValue, NumLoc, Len(pattern))
Exit Function
End If
Next
GetTextByPattern = ""
End Function
Example use:
dim bill as String
bill = "BILLNUMBER 2202/1132/1 PT2200136"
Debug.Print GetNumLoc(bill , "PT#######")
'Printed result:
'24
Debug.Print GetTextByPattern(bill , "PT#######")
'Printed result:
'PT2200136