i want to replace only 1 string but what happens is it replaces all matching strings.
i selected Ball from list1(listbox ) and find and replace that on text1 , it finders the value in text1 but other strings similar to the name ball gets changed also.
i have a list1
i have text1.text multiline
list1 keywords
ground
swimming
snooker
Ball
james
text1.text
hiker
Ball
Balla
jeans
am using
If Text1.Text = list1.Text Then
Text1 = Replace(Text1.Text, list1.Text, Text9.Text)
end if
am trying to do exact keyword replace here but am failing to do so.
am trying to replace Ball only but it replaces all matching keywords all together
Ball should be replaced only but Balla also geting replaced
RegExp is excellent to catch whole word, without the need to specify any specific boundaries. If you want to use this feature, try this:
Function ReplaceWholeWord(sText As String, sFind As String, sReplace As String)
With CreateObject("VBScript.Regexp")
.MultiLine = True: .Global = True
.Pattern = "\b" & sFind & "\b"
ReplaceWholeWord = .Replace(s, sReplace)
End With
End Function
Sub Test()
Dim s As String
s = "hiker " & vbCrLf & "Ball 123" & vbCrLf & "Balla" & vbCrLf & "Ball" & vbCrLf & "foobar"
Debug.Print ReplaceWholeWord(s, "Ball", "Crystal")
End Sub
Related
I am reading a file line by line in Excel VBA.
I have some strings for example,
" ooo"
" ooo "
I want to find the number of empty spaces in the front of the string. If I use Trim, it is removing empty spaces from both back and front of the string.
You could use the LTrim and RTrim functions. - I would assume that is faster, than looping through the string and doing character comparisons.
Public Function NumberOfLeadingSpaces(ByVal theString As String) As Long
NumberOfLeadingSpaces = Len(theString) - Len(LTrim(theString))
End Function
Public Function NumberOfTrailingSpaces(ByVal theString As String) As Long
NumberOfTrailingSpaces = Len(theString) - Len(RTrim(theString))
End Function
Function test(s As String) As Integer
Dim str As String
str = "[abcdefghijklmnopqrstuvwxyz0123456789]"
Dim spaceCounter As Integer
For i = 1 To Len(s)
If Not Mid(s, i, 1) Like str Then
spaceCounter = spaceCounter + 1
Else
Exit For
End If
Next i
test = spaceCounter
End Function
By popular request: Why use this function instead of Trim, LTrim, etc?
Well, to summarize the full explanation, not all spaces can be removed with Trim. But they will be removed with this function.
Consider this example (I'll borrow PhilS' solution for illustrative purposes):
Sub testSpaceRemoval()
Dim str1 As String
str1 = " " & Chr(32) & Chr(160) & "a"
Debug.Print Chr(34) & str1 & Chr(34)
Debug.Print NumberOfLeadingSpaces(str1)
Debug.Print test(str1)
End Sub
Result:
" a"
2
3
Here we can see that the string clearly contains 3 spaces, but the solution using LTrim only counted 2.
So, what to use?
Well, it depends. If you have a dataset where you know you won't get non-breaking characters, use Trim as much as you want! If you think you can get non-breaking characters, Trim alone will not be enough.
Characters to look out for are, quoted from the explanation linked above:
leading, trailing, or multiple embedded space characters (Unicode character set values 32 and 160), or non-printing characters (Unicode character set values 0 to 31, 127, 129, 141, 143, 144, and 157)
Trim can remove chr(32) (as demonstrated above) but not chr(160), because 32 is the regular space and 160 is a non-breaking space.
If you're a stickler for covering your behind, consider this total solution:
Function cleanSpecialCharacters(str As String) As String
bannedChars = Chr(127) & "," & Chr(129) & "," & Chr(141) & "," & Chr(143) & "," & Chr(144) & "," & Chr(157) & "," & Chr(160)
str = Application.WorksheetFunction.Clean(str)
str = Application.WorksheetFunction.Trim(str)
For Each c In Split(bannedChars, ",")
str = Replace(str, c, "")
Next
cleanSpecialCharacters = str
End Function
For OP's particular question, it would have to be a little more tailored.
Sub blanks()
cadena = Cells(1, 1)
i = Len(cadena)
Do Until Mid(cadena, i, 1) <> " "
If Mid(cadena, i, 1) = " " Then contador = contador + 1
i = i - 1
Loop
Cells(2, 1) = contador
End Sub
Sub main()
Dim strng As String
Dim i As Long
strng = " ooo "
i = 1
Do While Mid(strng, i, 1) = " "
i = i + 1
Loop
MsgBox "number of front empty spaces: " & i - 1
End Sub
or use LTrim function:
Sub main2()
Dim strng As String
strng = " ooo "
MsgBox "number of front empty spaces: " & Len(strng) - Len(LTrim(strng))
End Sub
I have declared and assigned a value to a string variable in VBA.
The variable contains a number of line breaks, can you advise how to remove these, this variable has been assigned a value from an xml document using the following code:-
s = Application.GetOpenFilename()
myFolder = ActiveWorkbook.Path
s = Dir(myFolder & "\*.xml")
Do While s <> ""
If s <> "False" Then
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(s) Then
t = myFolder & "\" & Replace(FSO.GetTempName(), ".tmp", ".xml")
Name s As t
Set ts(0) = FSO.OpenTextFile(t, 1, False, -2)
FileContents = ts(0).READALL
ts(0).Close
Set ts(0) = Nothing
End If
End If
s = Dir$
loop
Can anyone advise a solution?
Thanks Nick
First, you need to determine which line break your variable has - or you can test for all of them using multiple replaces. Luckily, VBA has the vbConstants for line breaks which make your life a little easier:
myStr = Replace(myStr, vbCr, " ")
myStr = Replace(myStr, vbLf, " ")
myStr = Replace(myStr, vbCrLf, " ") '// or vbNewLine
Notice I've used a space as the replacement otherwise you will end up with words being merged:
Example of some text
with a line break
replacing the line break with a zero length string "" would result in:
Example of some textwith a line break
whereas replacing with a space " " will produce:
Example of some text with a line break
Just for fun another way of doing this is like so:
myStr = Join$(Split(myStr, vbCrLf), " ")
This uses the line break as a delimiter to split the string out into a single dimension array, then joins each element of the array with a space. No real advantage in either method just down to preference in this case.
I want to remove the line break that I have in a certain text. I check in this forum how to do it and there were several answers but no one works for me at least in powerpoint.
I saw one example with left method:
If Len(myString) <> 0 Then
If Right$(myString, 2) = vbCrLf Or Right$(myString, 2) = vbNewLine Then
myString = Left$(myString, Len(myString) - 2)
End If
End If
text = Left (text, number) gives me Type mismatch error
text = Left$ (text, number) gives me compile error: Type-declaration character does not match declared data type.
I also try to replace the line break with "" but it just did nothing. It didn't gave me an error but the line break was still there.
The line break that I am using is vbCrLf
Your problem is likely that versions of PPT since 2007 don't use VBCrLf as a paragraph-ending character. This explains which versions use what characters for line or paragraph ends:
Paragraph endings and line breaks
http://www.pptfaq.com/FAQ00992_Paragraph_endings_and_line_breaks.htm
It's from the PPT FAQ site that I maintain.
For the object in which you want to remove the vbCrLf, try using
myObj.TextFrame.TextRange.Replace vbCrLf, ""
If you want to do this to a string (not an object) you can try something like this:
Sub stripStrings()
Dim longString As String
Dim stringCopy As String
longString = "first paragraph" & vbCrLf & "second paragraph" & vbCrLf & "third paragraph" & vbCrLf
stringCopy = Replace(longString, vbCrLf, "")
MsgBox "longstring is now:" & vbCrLf & longString
MsgBox "stringcopy is:" & vbCrLf & stringCopy
End Sub
As you will see, this removes the line breaks. Adapt for your purpose...
edit As Steve Rindsberg pointed out, it may be that your version of Powerpoint is using something other than vbCrLf as the paragraph delimiting character. Here is some code to help you figure this out - for each shape with text in it, it will extract the text, showing all "control characters" (ASCII value < 32) as \xnn where nn is the value of the control character (so that vbCR will display as \x13 for example):
Sub displayControlCharacters()
Dim sh As Shape
Dim t As String
For Each sh In ActivePresentation.Slides(1).Shapes
If sh.TextFrame.HasText Then
sh.Select
t = sh.TextFrame.TextRange.Text
MsgBox "The shape contains: " & vbCrLf & escapeString(t)
End If
Next sh
End Sub
Function escapeString(t As String)
Dim ii As Integer
Dim r As String
For ii = 1 To Len(t)
If Asc(Mid(t, ii, 1)) > 31 Then
r = r + Mid(t, ii, 1)
Else
r = r + "\x" + Format(Asc(Mid(t, ii, 1)), "0")
End If
Next
escapeString = r
End Function
A simple test showed that in PowerPoint 2010 you do have just \x13 at the end of a paragraph...
(Note: See below for solution.)
I have been trying to retrieve the page numbers from pages that various headings reside on in a word document using VBA. My current code returns either 2 or 3, and not the correctly associated page numbers, depending on where and how I use it in my main Sub.
astrHeadings = docSource.GetCrossReferenceItems(wdRefTypeHeading)
For Each hds In astrHeadings
docSource.Activate
With Selection.Find
.Text = Trim$(hds)
.Forward = True
MsgBox hds & ":" & Selection.Information(wdActiveEndPageNumber), vbOKOnly
End With
Selection.Find.Execute
Next
docSource is a test document I have set up with 10 headings over 3 pages. I have the headings retrieved from the getCrossReferenceItems method in use later in my code.
What I am attempting is to loop through the results from the getCrossReferenceItems method and use each them in a Find object on docSource and from this ascertain what page the result is on. The page numbers will then be used in a string later in my code. This string plus page number will be added to another document which is created at the beginning of my main sub, everything else works a treat but this code segment.
Ideally what I need this segment to do is fill a second array with the associated page numbers from each Find result.
Problems Solved
Thanks Kevin you have been a great help here, I now have exactly what I need from the output of this Sub.
docSource is a test document I have set up with 10 headings over 3 pages.
docOutline is a new document which will act as a Table of Contents document.
I have had to use this Sub over Word's built-in TOC features because:
I have multiple documents to include, I could use the RD field to include these but
I have another Sub which generates custom decimal page numbering in each document 0.0.0 (chapter.section.page representative) that, for the whole document package to make sense, need to be included in the TOC as page numbers. There probably is another way of doing this but I came up blank with Word's built-in features.
This will become a Function to be included in my page numbering Sub. I am currently 3/4 of the way to completing this little project, the last quarter should be straightforward.
Revised and cleaned final Code
Public Sub CreateOutline()
' from http://stackoverflow.com/questions/274814/getting-the-headings-from-a-word-document
Dim docOutline As Word.Document
Dim docSource As Word.Document
Dim rng As Word.Range
Dim strFootNum() As Integer
Dim astrHeadings As Variant
Dim strText As String
Dim intLevel As Integer
Dim intItem As Integer
Dim minLevel As Integer
Dim tabStops As Variant
Set docSource = ActiveDocument
Set docOutline = Documents.Add
minLevel = 5 'levels above this value won't be copied.
' Content returns only the
' main body of the document, not
' the headers and footer.
Set rng = docOutline.Content
astrHeadings = docSource.GetCrossReferenceItems(wdRefTypeHeading)
docSource.Select
ReDim strFootNum(0 To UBound(astrHeadings))
For i = 1 To UBound(astrHeadings)
With Selection.Find
.Text = Trim(astrHeadings(i))
.Wrap = wdFindContinue
End With
If Selection.Find.Execute = True Then
strFootNum(i) = Selection.Information(wdActiveEndPageNumber)
Else
MsgBox "No selection found", vbOKOnly
End If
Selection.Move
Next
docOutline.Select
With Selection.Paragraphs.tabStops
'.Add Position:=InchesToPoints(2), Alignment:=wdAlignTabLeft
.Add Position:=InchesToPoints(6), Alignment:=wdAlignTabRight, Leader:=wdTabLeaderDots
End With
For intItem = LBound(astrHeadings) To UBound(astrHeadings)
' Get the text and the level.
' strText = Trim$(astrHeadings(intItem))
intLevel = GetLevel(CStr(astrHeadings(intItem)))
' Test which heading is selected and indent accordingly
If intLevel <= minLevel Then
If intLevel = "1" Then
strText = " " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr
End If
If intLevel = "2" Then
strText = " " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr
End If
If intLevel = "3" Then
strText = " " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr
End If
If intLevel = "4" Then
strText = " " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr
End If
If intLevel = "5" Then
strText = " " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr
End If
' Add the text to the document.
rng.InsertAfter strText & vbLf
docOutline.SelectAllEditableRanges
' tab stop to set at 15.24 cm
'With Selection.Paragraphs.tabStops
' .Add Position:=InchesToPoints(6), _
' Leader:=wdTabLeaderDots, Alignment:=wdAlignTabRight
' .Add Position:=InchesToPoints(2), Alignment:=wdAlignTabCenter
'End With
rng.Collapse wdCollapseEnd
End If
Next intItem
End Sub
Private Function GetLevel(strItem As String) As Integer
' from http://stackoverflow.com/questions/274814/getting-the-headings-from-a-word-document
' Return the heading level of a header from the
' array returned by Word.
' The number of leading spaces indicates the
' outline level (2 spaces per level: H1 has
' 0 spaces, H2 has 2 spaces, H3 has 4 spaces.
Dim strTemp As String
Dim strOriginal As String
Dim intDiff As Integer
' Get rid of all trailing spaces.
strOriginal = RTrim$(strItem)
' Trim leading spaces, and then compare with
' the original.
strTemp = LTrim$(strOriginal)
' Subtract to find the number of
' leading spaces in the original string.
intDiff = Len(strOriginal) - Len(strTemp)
GetLevel = (intDiff / 2) + 1
End Function
This code is now producing (What it should be according to my headings specification found in test-doc.docx):
This is heading one 1.2.1
This is heading two 1.2.1
This is heading two.one 1.2.1
This is heading two.three 1.2.1
This is heading one.two 1.2.2
This is heading three 1.2.2
This is heading four 1.2.2
This is heading five 1.2.2
This is heading five.one 1.2.3
This is heading five.two 1.2.3
In Addition to this I have solved the ActiveDocument switching issue by using docSource.select and docOutline.Select statements instead of using.Active.
Thanks again Kevin, greatly appreciated :-)
Phil
It looks like Selection.Information(wdActiveEndPageNumber) will fit the bill, although it's in the wrong point of your code currently. Put this line after you execute the find, like so:
For Each hds In astrHeadings
docSource.Activate
With Selection.Find
.Text = Trim$(hds)
.Forward = True
End With
Selection.Find.Execute
MsgBox hds & ":" & Selection.Information(wdActiveEndPageNumber), vbOKOnly
Next
Addition for new question:
When you're setting the strFooter values, you're using ReDim to resize the array when you should be using ReDim Preserve:
ReDim Preserve strFootNum(1 To UBound(astrHeadings))
But, unless UBound(astrHeadings) is changing during the For loop in question, it'd probably be best practice to pull the ReDim statement outside of the loop:
ReDim strFootNum(0 To UBound(astrHeadings))
For i = 0 To UBound(astrHeadings)
With Selection.Find
.Text = Trim(astrHeadings(i))
.Wrap = wdFindContinue
End With
If Selection.Find.Execute = True Then
strFootNum(i) = Selection.Information(wdActiveEndPageNumber)
Else
strFootNum(i) = 0 'Or whatever you want to do if it's not found'
End If
Selection.Move
Next
For reference, the ReDim statement sets all the items in an array back to 0, whereas ReDim Preserve preserves all the data in the array before you resize it.
Also note the Selection.Move and the .Wrap = wdFindContinue lines - I think these were the root of the issue with my previous suggestions. The selection would be set to the final page because the find wasn't wrapping on any run of this other than the first run.
if i have a textbox with contents like "the big brown fox jumped over the lazy dog",
how do i split it and put the contents in a listbox like this:
0,the
1,big
2,brown
3,fox
4,jumped
5,over
6,the
7,lazy
8,dog
PLz help, newbie
You could use the Split() function. Something like this:
Public Function SplitToListBox(ByVal strInput As String) As String
Dim strTemp() As String
Dim intCounter As Integer
Dim strRowsource As String
Const strQuote As String = """"
strTemp() = Split(strInput, " ")
For intCounter = 0 To UBound(strTemp())
If Len(strRowsource) = 0 Then
strRowsource = strQuote & Trim(CStr(intCounter)) & strQuote & "; " & strQuote & strTemp(intCounter) & strQuote
Else
strRowsource = strRowsource & "; " & strQuote & Trim(CStr(intCounter)) & strQuote & "; " & strQuote & strTemp(intCounter) & strQuote
End If
Next intCounter
SplitToListBox = strRowsource
End Function
Now, you'd then need a listbox defined with two columns, and you'd want to set the widths on those columns appropriately (0.5";1" works if you want to see both; 0";1" works if you want the first column to be hidden (though it will be the bound column if you don't change the default properties). You also need to set the RowSourceType property to "Value List".
One caveat:
There's a hard limit on the length of the Rowsource property when it's a Value List. I can't remember the exact number, but it's somewhere upward of 2000 characters. If you need more than that, then I'd suggest you convert the code that creates the list to a custom function. There are instructions on how to do this in the help for combo-/listboxes.