Why are my spaces not trimmed - excel

This seems obvious and straightforward, but it's not working. I'm working from in Excel VBA. I get the open Word application and extract text from a bookmarked spot within a table in Word. Then the trouble starts. The resulting string is 5 chr(32) spaces. But whatever I try, I can't get rid of the spaces. Why are the spaces not being trimmed or replaced?
Dim Wd As Word.Application
Set Wd = GetObject(, "Word.Application")
Dim doc As Word.Document
'Dim r As Word.Range
'Dim p As Word.Paragraph
Dim tb As Word.Table
Set doc = Wd.ActiveDocument
Set tb = doc.Tables(1)
'tb.Select
Dim Place As String
Place = Trim(doc.Bookmarks("County").Range.Text)
'outputs length 5
Debug.Print Len(Place)
'this outputs 32 5 times so I know we have chr(32) and not something else
Dim i As Integer
For i = 1 To Len(Place)
Debug.Print Asc(Mid(Place, i, 1))
Next
'try trim
Place = Trim(Place)
Debug.Print Len(Place)
'still 5 spaces
'try replace
Dim s As String
s = VBA.Replace(Place, Chr(32), "")
Debug.Print Len(Place)
'still 5 spaces
What is happening with my code?

Probably a unicode space, consider U2000 EN QUAD Whitespace:
x="W" & chrw(&h2000) & "W"
?x
W W
?asc(mid(x,2,1))
32 <= normalized
?ascw(mid(x,2,1))
8192 <= true character
So examine the char with ascw and replace with chrw

Related

Copying multiple line text Cell from Word Table to Excel Cell

I figured out how to copy the cell directly from a Word table to a Excel Cell.
The cell in Word may contain multiple lines separated by pressing enter. So you have one line, press enter, next line and so on.
I want to copy this exactly as it looks into Excel. When I copy it, the entire string is one line in the Excel cell.
First capture is from Word and the next is an Excel cell.
Below is the code for copying into the first column. The rest are not needed. I am working in the Outlook so that is why I have the Excel library and the Word library being used. The code will scrape emails with Word documents.
With wrd.Tables(1)
xlSht.Cells(j, 1).Value = WorksheetFunction.Clean(.Cell(2, 2).Range.Text)
xlSht.Cells(j, 2).Value = WorksheetFunction.Clean(.Cell(3, 2).Range.Text)
xlSht.Cells(j, 4).Value = Atmt.FileName
End With
I tried splitting the Excel cell with some logic but it is hard to detect where the enter needs to happen.
Note: The "and" will not be used in all the text. It varies so I can't use that to split the Excel cell.
To start, make sure that the "Wrap Text" option is enabled on the cell
you are writing to or it won't display line breaks properly even if
they exist in the text.
Now that this is cleared out of the way, there are 2 different reasons why your code doesn't preserve the line breaks from the Word table. The first is that you are using the CLEAN function. The second is that there's a problem with how data is passed from the Word table using VBA (some information is lost). Luckily, there are ways to solve those problems.
Avoid using the CLEAN function
When you use the CLEAN function, you remove all the non-printable characters from a string of text. The problem is that the "formatting" that you see in the Word table is actually caused by the presence of 2 non-printable characters (or at least one of them). Those characters are the carriage return (CR) and the line feed (LF) characters. By using the CLEAN function you are asking to remove those characters which removes the information indicating a line break.
So I tried to do the same as you without the CLEAN function and made a Word table
then I used the following code to write the content of the first cell to Excel.
Sub ReadFromWordTable()
Dim WordApp As Word.Application
Set WordApp = GetObject(, "Word.Application")
Dim WordDoc As Word.Document
Set WordDoc = WordApp.ActiveDocument
Dim xlSht As Worksheet
Set xlSht = ActiveSheet
Dim TempString As String
With WordDoc.Tables(1)
TempString = .Range.Text
End With
xlSht.Cells(1, 1).Value2 = TempString
'StringDrillDown TempString
End Sub
and saw that the line break does not appear (we'll come back to this later) and that there is some garbage characters at the end of my cell.
Now I see why you used the CLEAN function : to make those garbage characters go away! If only there was an out-of-the-box VBA function to remove those non-printable characters without removing CR and LF from the string!
Since there isn't any and that they only appear at the end, I would suggest to simply clean TempString using the following code which will remove all the non-printable characters starting from the right and stop as soon as it encounters a printable character.
Dim i As Long, NbOfCharacter As Long
NbOfCharacter = Len(TempString)
For i = Len(TempString) To 1 Step -1
If Asc(Mid(TempString, i, 1)) < 32 Then
NbOfCharacter = NbOfCharacter - 1
Else
Exit For
End If
Next
TempString = Left(TempString, NbOfCharacter)
Note here that I'm using the Asc function. It returns the Extended ASCII (aka. ANSI) character code (a number from 1 to 255) that uniquely identifies a character. In our case, all non-printable characters return a value below 32 so we can easily filter them out.
Make sure the line feed character is present in the string you write to the cell
As you saw when we used the value of .Range.Text directly, the line break didn't get passed through correctly. To understand the problem, we might want to drill down on the different characters that make up our TempString variable. For that you could use a procedure like this:
Sub StringDrillDown(str As String)
Dim ws As Worksheet
With ActiveWorkbook
Set ws = .Sheets.Add(AFTER:=.Sheets(.Sheets.Count))
End With
ws.Range("A1") = "Character"
ws.Range("B1") = "Ascii Code"
Dim i As Long
For i = 1 To Len(str)
ws.Cells(i + 1, 1).Value2 = Mid$(str, i, 1)
ws.Cells(i + 1, 2).Value2 = Asc(Mid$(str, i, 1))
Next i
End Sub
Giving us this:
What we notice is that the only character we have between "and" and "some" is the character number 13 which corresponds to CR (this seems to be a quirk of how string data is transferred between Word and Excel). So, we are missing the LF requiered to make it clear to Excel that we want a line break between those 2 words.
To solve this issue, we could use the following :
With WordDoc.Tables(1)
TempString = Replace(.Cell(1, 1).Range.Text, Chr(13), Chr(13) & Chr(10))
End With
This code will replace all lonely CR by a CRLF (note that the character code for LF is 10).
A cautionary note: If there were already CRLF characters in the string, the line of code above would double them but that's not the case here.
Finally, our initial code example would now be the following:
Sub ReadFromWordTable()
Dim WordApp As Word.Application
Set WordApp = GetObject(, "Word.Application")
Dim WordDoc As Word.Document
Set WordDoc = WordApp.ActiveDocument
Dim xlSht As Worksheet
Set xlSht = ActiveSheet
Dim TempString As String
With WordDoc.Tables(1)
TempString = Replace(.Cell(1, 1).Range.Text, Chr(13), Chr(13) & Chr(10))
End With
Dim i As Long, NbOfCharacter As Long
NbOfCharacter = Len(TempString)
For i = Len(TempString) To 1 Step -1
If Asc(Mid(TempString, i, 1)) < 32 Then
NbOfCharacter = NbOfCharacter - 1
Else
Exit For
End If
Next
TempString = Left(TempString, NbOfCharacter)
xlSht.Cells(1, 1).Value2 = TempString
'StringDrillDown TempString
End Sub

pull full names and surname/surnames form the consecutive paragraphs in Excel / Word VBA

First Things First: The macro is run from Excel VBA editor, but performs the biggest part of its job on the previously opened Word document, where it's goal is to find the full names of the people who are the contracting parties in the agreement being analized.
The issue I'm experiencing with the code is that it is variable number of words, that I need to pull from every consecutive paragraph. If the name is Will SMITH, then its two words I need to pull, when it's Carrie Ann MOSS, then it's three words, sometimes it can be Anna Nicole SMITH BURKE, than its four words but when it's Anna Nicole SMITH-BURKE, than its five words and so on.
The other idea to get this full name is, that it always ends with a coma, and this coma is always the first coma in this paragraph, where the full name appears.
ATTENTION !!! The Paragraphs we work with are not ListParagraphs. They are the normal/ordinary ones albeit indented and numbered. I get these contracts from people who don't care to use numbered list :-(
So for the last time: The numbered list is not enabled on those paragraphs we work with.
This is how it looks like in Word and the selected words are the names and surnames that the macro is supposed to extract from the document - excluding the coma after the last surname.
Sub FindNamesCleanDraftWithLoop()
'Variables declaration
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim ExcelApp As Excel.Application
Dim MySheet As Excel.Worksheet
Dim Para As Word.Paragraph
Dim Rng As Word.Range
Dim RngStart As Word.Range
Dim RngEnd As Word.Range
Dim TextToFind1 As String
Dim TextToFind2 As String
Dim firstName As String
Dim startPos As Long
Dim endPos As Long
Application.ScreenUpdating = False
'Assigning object variables
Set WordApp = GetObject(, "Word.Application")
Set ExcelApp = GetObject(, "Excel.Application")
Set WordDoc = WordApp.ActiveDocument
Set MySheet = Application.ActiveWorkbook.ActiveSheet
'Set MySheet = ExcelApp.ActiveWorkbook.ActiveSheet
Set Rng = WordApp.ActiveDocument.Content
TextToFind1 = "REGON 364061169, NIP 951-24-09-783,"
TextToFind2 = "- ad."
'InStr function returns a Variant (Long) specifying the position of the first occurrence of one string within another.
startPos = InStr(1, Rng, TextToFind1) - 1 'here we get 1421, we're looking 4 "TextToFind1"
endPos = InStr(1, Rng, TextToFind2) - 1 'here we get 2246, we're looking 4 "- ad."
If startPos = 0 Or endPos = 0 Then Exit Sub
Rng.SetRange Start:=startPos, End:=endPos
Debug.Print Rng.Paragraphs.Count
If startPos = 0 Or endPos = 0 Then
MsgBox ("Client's names were not found!")
Else
'somewhere here I need your help to write some lines that will
'recognize how many words need to be pulled to extract the full
'name/names + surname/surnames and nothing else - we end on the first coma.
For Each Para In Rng.Paragraphs
firstName = Trim$(Para.Range.Words(3))
Debug.Print Para.Range.Words(1) & Para.Range.Words(2) & _
Para.Range.Words(3) & Para.Range.Words(4) & _
Para.Range.Words(5) & Para.Range.Words(6)
Next Para
End If
End Sub
There in the For Each Para ... Next Para loop, I need your help to write some lines that will recognize how many words need to be pulled to extract the full name/names + surname/surnames and nothing else - we end on the first coma - that means excluding the coma after the last surname.
This might do what you want, if I have understood correctly.
If the Number and Dot are NOT part of the paragraph, then to extract the full name, you could use:
Debug.Print Left(Para, InStr(Para, ",") - 1)
If the Number and Dot ARE part of the paragraph, then:
Dim Start As Long, Length As Long
Start = InStr(Para, ".") + 1
Length = InStr(Para, ",") - Start
Debug.Print Trim(Mid(Para, Start, Length))
If you want to split the capitalized portion of the name from the rest, post several samples of the actual strings as TEXT as I am unable to copy/paste your screenshots into Excel.
This is actually question on Natural Language Processing - NLP (as scientific field) - problem of Tokenization you already solved, but you are now facing with: Part of Sentence (POS) tagging (and construction of semantic Chunk-s). Issue of Person Identity recognition is one of first since very dawn of the discipline, so, there are many libraries for this, but I'm skeptic you'll find anything you can use from VBA that easy. Also, for comprehensive/robust solution you'll need proper lexicon with names and lastnames (suitable resource would be a Morpho-sintactic Lexicon/Dictionary, extracted only for PName LName tags).
To solve this, you'll have to do some research on keywords mentioned above. I have no experience with VBA, but asume C# and .NET would be the easiest to integrate. Therefore, Standford CoreNLP for .NET would be starting point I recon: https://sergey-tihon.github.io/Stanford.NLP.NET/StanfordCoreNLP.html
Highly relevant lexical source for English:
https://wordnet.princeton.edu/
You can query WordNet lexicon using WordNet.NET. I've used both and its very good resource&library.

Find unknown name and surname in opened Word document, copy it and paste into the cell A12 in excel .activesheet with excel VBA

Hello Stackoverflow community.
My goal is to write a macro that finds unknown name (or both names written like so "Firstname Secondname") and surname (or both surnames written like so "Firstsurname-Secondsurname") in previously opened/active Word document - there will be only one Word document opened on the computer at the time. I want to find and copy the name and surname from point 2.
Next the macro should copy this name and paste it into the cell A12 in excel"s .activesheet. Only one excel workbook will be opened on the computer at the time.
The structure of the word document is quite consistent and apart from names and personal/id numbers everything stays the same, but no word bookmarks are created. I've found the text that never changes in point 1. = "REGON 364061169, NIP 951-24-09-783,".
It's before the name+surname I want to find and copy - I hope it helps.
But also the text "2. " is directly before the name+surname I want to copy and although in the whole contract the string "2. " appears over 20 times, this is the 1st "2. " occurence that precedes name+surname I want to copy and paste into excel's cell.
Name+surname changes all the time, is unknown and has different number of words/characters every time.
Sub FindNames()
'Variables declaration
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim ExcelApp As Excel.Application
Dim MySheet As Worksheet
Dim TextToFind As String
Dim FirstName As String
Dim Rng As Word.Range
Dim StartPos As Long
Dim EndPos As Long
Application.ScreenUpdating = False
TextToFind = "REGON 364061169, NIP 951-24-09-783," 'this text length is 21 caracters
'Assigning object variables
Set WordApp = GetObject(, "Word.Application")
Set ExcelApp = GetObject(, "Excel.Application")
Set WordDoc = WordApp.ActiveDocument
Set MySheet = Application.ActiveWorkbook.ActiveSheet
'Set MySheet = ExcelApp.ActiveWorkbook.ActiveSheet
Set Rng = WordApp.ActiveDocument.Content
'InStr function returns a Variant (Long) specifying the position of the _
first occurrence of one string within another.
StartPos = InStr(1, Rng, TextToFind) 'here we get 1420, we're looking 4 "TextToFind"
EndPos = InStr(StartPos, Rng, "§ 1. ") 'here we get 2742, we're looking 4 ",00zł"
If StartPos = 0 Or EndPos = 0 Then
MsgBox ("Client's names were not found!")
Else
StartPos = StartPos + Len(TextToFind) 'now start position is reassigned at 1455;
FirstName = Mid(Rng, StartPos, EndPos - StartPos)
End If
'len(Firstname)
End Sub
This is the best I can write, but I cannot isolate only name+surname from the bigger variable = FirstName.
My version of the code provided by #PeterT, which is not working for me.
Rng.SetRange Start:=StartPos, End:=EndPos
Debug.Print Rng.Paragraphs.Count
If StartPos = 0 Or EndPos = 0 Then
MsgBox ("Client's names were not found!")
'finding the paragraphs that follow the TextToFind1
Else
For Each Para In Rng.Paragraphs
'how to identify the second paragraph?
'these are not .ListParagraphs, they're normal paragraphs
'If Para.Range.ListParagraphs.Count = 1 Then
If Para.Range.Paragraphs.Count = 2 Then
'how to access the second paragraph?
'If Para.Range.ListFormat.ListValue = 2 Then
'Para.Range.Paragraphs(1).Next(Count:=1).Range
'If Para.Range.Paragraphs.Count = 2 Then
Debug.Print "Name = " & Para.Range.Words(1) & _
", Surname = " & Para.Range.Words(2)
End If
Next Para
End If
I can't access second paragraph and extract the "Michał Łukasz ROESLER" string.
I'd also like to extract "Katarzyna Paula STANISZKIS-KRAWCZYK" from the third paragraph in the Rng. Both of them are on the first page of the document.
This answer is deliberately separate from my previous example. That other example
is based on finding paragraphs formatted as ListParagraphs, and
remains valid if your search must include that formatting style.
This answer assumes the numbered paragraphs are simply regular paragraphs (albeit >indented and numbered). No error checking is performed in this example, e.g. if the >paragraph is not numbered or the names are located elsewhere in the paragraph.
By setting up the searchRange in the manner below, you are assured that the first paragraph is the one containing your search term. In this case, it's the paragraph for Item 1. Since the searchRange is defined using the search term, you're assured that the name is in the next paragraph. No loop is necessary.
Option Explicit
Sub FindNames2()
Dim textToFind As String
textToFind = "REGON 364061169, NIP 951-24-09-783,"
Dim searchArea As Word.Range
Set searchArea = ThisDocument.Content
Dim startPos As Long
Dim endPos As Long
startPos = InStr(1, searchArea, textToFind)
If (startPos = 0) Then Exit Sub
'--- adjust the area to start from where we found the text
' until the end of the document
searchArea.SetRange Start:=startPos, End:=searchArea.End
'--- we want the name at the start of the very next paragraph
' (the current paragraph with the text to find is paragraph 1)
Dim theParagraph As Word.Paragraph
Set theParagraph = searchArea.Paragraphs(2)
Dim itemNumber As Long
Dim firstName As String
Dim lastName As String
itemNumber = CLng(Trim(theParagraph.Range.Words(1)))
firstName = Trim$(theParagraph.Range.Words(3))
lastName = Trim$(theParagraph.Range.Words(4))
Debug.Print "Name = " & firstName & " " & lastName & " in Item #" & itemNumber
End Sub
A couple things to note from additional example in the OP.
The endPos may be zero, even if the search text is found. My testing showed that checking the startPos was sufficient.
When accessing a Word(3), for example, the returned text may have whitespace on one or both sides of the word. Using the Trim$ function removes that whitespace.
You can access the name in the paragraph below by incrementing from Paragraphs(2) to Paragraphs(3).
This example code assumes you are executing the macro from the MS Word document.
Option Explicit
Sub FindNames()
Dim textToFind As String
textToFind = "REGON 364061169, NIP 951-24-09-783,"
Dim searchArea As Word.Range
Set searchArea = ThisDocument.Content
Dim startPos As Long
Dim endPos As Long
startPos = InStr(1, searchArea, textToFind)
If startPos = 0 Then Exit Sub
'--- adjust the area to start from where we found the text
' until the end of the document
searchArea.SetRange Start:=startPos, End:=searchArea.End
'--- now find the list paragraphs that follow the text
Dim para As Word.Paragraph
For Each para In searchArea.Paragraphs
'--- identify the list paragraph
If para.Range.ListParagraphs.Count = 1 Then
'--- find the second item in the list
If para.Range.ListFormat.ListValue = 2 Then
Debug.Print "Name = " & para.Range.Words(1) & _
", Surname = " & para.Range.Words(2)
End If
End If
Next para
End Sub
The best way to do this is create a Word.Range, search the range, then adjust it to capture the names.
Dim srchRng as Word.Range
Dim thisDoc as Word.Document: Set thisDoc = Word.ActiveDocument
Set srchRange = thisDoc.Content
With srchRange.Find
.Text = "REGON 364061169, NIP 951-24-09-783,"
.Execute
If .Found = True Then
srchRange.MoveEndUntil Cset:="."
srchRange.MoveEnd wdWord, 3
If srchRange.Words.Last.Next.Text = "-" Then
srchRange.MoveEnd wdWord, 2
End If
Dim nameStart As Long
nameStart = InStr(1, srchRange.Text, "2. ")
Dim fullName As String
fullName = Mid(srchRange.Text, nameStart + 3)
End If
End With
Debug.Print fullName

Read a Text file which has huge line (more than 1024 characters) using VBA macro

I need to pick a particular data from a text file. But this text file has data which is more than 1024 characters on a single line.
For eg: I need data between string text1 and text 2. My code takes only the first data between text1 & text2 in the huge line, and moves to next line. But previous huge line has multiple instances of text1 & text2. I am not able to get those data. Please help. Find below my code:
Sub Macro1()
Dim dat As String
Dim fn As String
fn = "C:\Users\SAMUEL\Desktop\123\Source1.TXT" '<---- change here
With CreateObject("Scripting.FileSystemObject").OpenTextFile(fn)
Do While Not .AtEndOfStream
dat = .Readline
If InStr(1, dat, "text1", vbTextCompare) > 0 Then
x = InStr(dat, "text1") + 8
y = InStr(dat, "text2")
Z = y - x
MsgBox Mid(dat, x, Z)
End If
Loop
.Close
End With
End Sub
I want to pick the data between Text1 and Text2 to a specific cell.
The data looks like "This is an Text1 awesome Text2 website. I like this Text1 website Text2."
This is a huge data which I copied from a website. When I save in a Text file, one line of this web data is more than 4000 characters. So the line in text file ends at 1024 characters and data moves to next line that becomes 3 lines. But My macro takes first 1024 in string "dat" and moves to second line of web data, that means it skips all data after 1024 characters to 4000 characters. The data I want which exists between Text1 and Text2 could be anywhere in whole 4000 characters, But It will be in same pattern. It will never be like Text1...Text1...Text2..
Using a regexp is a useful way to quickly replace all matches in a single shot, or work through each match (including multiple matches per line) as this sample does below.
Sub DisappearingSwannie()
Dim objFSO As Object
Dim objFil As Object
Dim objRegex As Object
Dim objRegMC As Object
Dim objRegM As Object
Dim strIn As String
Dim X
Dim lngCnt As Long
Dim fn As String
fn = "C:\temp\test.TXT" '<---- change here
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRegex = CreateObject("vbscript.regexp")
Set objFil = objFSO.OpenTextFile(fn)
X = Split(objFil.readall, vbNewLine)
With objRegex
.Global = True
.Pattern = "text1(.+?)text2"
End With
For lngCnt = 1 To UBound(X)
If objRegex.test(X(lngCnt)) Then
Set objRegMC = objRegex.Execute(X(lngCnt))
For Each objRegM In objRegMC
Debug.Print "line " & lngCnt & " position:" & objRegM.firstindex
Next
End If
Next
End Sub
Here is a macro that looks in A1 and B1 for Text1 and Text2. It then allows you to pick a file to process and parses out the substrings from text1 to text2 inclusive. Finally, it splits them into chunks of no more than 1024 characters (ensuring that each chunk ends with a space, so as not to split words), and writes them into a series of rows in column A starting in A2.
Both the parsing of the substrings, and the breaking them up into 1024 character chunks, are accomplished using regular expressions. The "work" is done in VBA arrays as this is faster than going back and forth to the worksheet.
Since the length of a string variable can be approximately 2^31 characters, I doubt you will have any problem reading the entire document into a single variable and then processing it, instead of going line by line.
Since the macro has arguments, you will need to call it from another macro; or it should be trivial for you to change the code to allow different methods of input for text1 and text2.
There is no error checking.
If you do not want to include Text1 and Text2 in the results, a minor change in the regular expression pattern is all that would be required.
I used early binding so as to take advantage of the "hints" while writing the macro. This requires setting references as noted in the macro. However, it should be simple for you to change this to late binding if you wish.
You might also consider a modification so that the multi-row chunks are somehow differentiated from the single row chunks.
Enjoy
Option Explicit
'Set Reference to Microsoft Scripting Runtime
'Set Reference ot Microsoft VBScript Regular Expressions 5.5
Sub ExtractPhrases(Text1 As String, Text2 As String)
Dim FSO As FileSystemObject
Dim TS As TextStream
Dim FN As File, sFN As String
Dim RE As RegExp, MC As MatchCollection, M As Match
Dim RE2 As RegExp, MC2 As MatchCollection, M2 As Match
Dim sPat As String
Dim S As String, sTemp As String
Dim V() As Variant, vRes() As Variant
Dim I As Long, J As Long, K As Long
Dim C As Range
Dim rRes As Range
'Get File path
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.ButtonName = "Process File"
.Filters.Add "Text", "*.txt", 1
.FilterIndex = 1
.InitialView = msoFileDialogViewDetails
If .Show = -1 Then sFN = .SelectedItems(1)
End With
'Read File into String variable
Set FSO = New FileSystemObject
Set TS = FSO.OpenTextFile(FileName:=sFN, IOMode:=ForReading, Create:=False)
S = TS.ReadAll
'Get results
Set RE = New RegExp
Set RE2 = New RegExp
With RE2
.Global = True
.MultiLine = False
.Pattern = "(\S[\s\S]{1,1023})(?:\s+|$)"
End With
With RE
.Global = True
.IgnoreCase = True
.Pattern = "\b" & Text1 & "\b([\s\S]+?)\b" & Text2 & "\b"
If .Test(S) = True Then
ReDim vRes(0)
Set MC = RE.Execute(S)
For I = 1 To MC.Count
Set MC2 = RE2.Execute(MC(I - 1))
ReDim V(1 To MC2.Count)
For J = 1 To MC2.Count
V(J) = MC2(J - 1).SubMatches(0)
Next J
ReDim Preserve vRes(UBound(vRes) + J - 1)
For J = 1 To MC2.Count
K = K + 1
vRes(K) = V(J)
Next J
Next I
End If
End With
vRes(0) = "Phrases"
'transpose vRes
ReDim V(1 To UBound(vRes) + 1, 1 To 1)
For I = 0 To UBound(vRes)
V(I + 1, 1) = vRes(I)
Next I
Set rRes = Range("a2").Resize(rowsize:=UBound(V))
Range(rRes(1), Cells(Rows.Count, rRes.Column)).Clear
rRes = V
End Sub

VB: Read "x" integer from a string and replace it

First of all, I am not from programming background and totally new to VB. For some reasons, I have to do a small scripting task at office.
I have gone through many posts here as well on other forums but not able to find the required information.
Ok so here's what I need to do:
I want to find an integer from a string (the integer can be any from 5 to 4095) and replace it with an integer of my choice.
I have done some analysis but not able to find a function which can search for "any" integer from a string. Searching for fixed integers is working fine.
e.g:
Convert: "There are 10 apples" - where 10 can be any number from 5 to 4095, not known to me.
To: "There are 5 apples" - 5 is the number I will manually give.
Any help is appreciated.
Thank you.
Edit
Final Code:
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFile = "C:\Users\inkasap\Desktop\temp\IOParams_Backup.xml"
Set objFile = objFSO.OpenTextFile(strFile)
Do Until objFile.AtEndOfStream strLine = objFile.ReadLine
Dim re, strLine
Set re = New RegExp
if InStr(strLine,"name=""BIOSCUPP") > 0 Then
re.Pattern = "\d+"
Set colMatch = re.Execute(strLine)
For Each objMatch In colMatch
strLine = Replace(strLine, objMatch.Value, "30")
Next end
if WScript.Echo strLine
Loop
Well, you can use regular expressions to find any numerical value, and then replace it:
Dim re, test
Set re = New RegExp
re.Pattern = "\d+"
test = "There are 4000 apples"
Set colMatch = re.Execute(test)
For Each objMatch In colMatch
MsgBox(Replace(test,objMatch.Value,"5"))
Next
This page contains all informations you need.
You can use a RegularExpressions with Regex.Replace method:
Dim str = "There are 10 apples"
Dim regex = New System.Text.RegularExpressions.Regex("\d+", System.Text.RegularExpressions.RegexOptions.Compiled)
Dim replaced = regex.Replace(str, "5") ' "There are 5 apples" '
Edit: Just only seen that you need a vbscript instead of VB.NET approach.

Resources