Remove non-numeric characters from a range of cells [closed] - regex

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 7 years ago.
Improve this question
I have a 1500 row excel file.
In the first column I have characters mixed up with numbers (every row is different).
I would like to leave only the numbers and delete the alpha characters.
For example in A1 I have
f90f5j49,35.48
and after I delete the alpha characters it should be
905493548
What is the best way to do this?
I did find this youtube solution
Thanks!

Your method is the right approach.
The quickest way to implement this is to use
a regexp
and a variant array in VBA.
Using code based on my Article Using Variant Arrays in Excel VBA for Large Scale Data Manipulation
Sub KillNonNumbers()
Dim rng1 As Range
Dim rngArea As Range
Dim lngRow As Long
Dim lngCol As Long
Dim lngCalc As Long
Dim objReg As Object
Dim X()
On Error Resume Next
Set rng1 = Application.InputBox("Select range for the replacement of non-number", "User select", Selection.Address, , , , , 8)
If rng1 Is Nothing Then Exit Sub
On Error GoTo 0
'See Patrick Matthews excellent article on using Regular Expressions with VBA
Set objReg = CreateObject("vbscript.regexp")
objReg.Pattern = "[^\d]+"
objReg.Global = True
'Speed up the code by turning off screenupdating and setting calculation to manual
'Disable any code events that may occur when writing to cells
With Application
lngCalc = .Calculation
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
'Test each area in the user selected range
'Non contiguous range areas are common when using SpecialCells to define specific cell types to work on
For Each rngArea In rng1.Areas
'The most common outcome is used for the True outcome to optimise code speed
If rngArea.Cells.Count > 1 Then
'If there is more than once cell then set the variant array to the dimensions of the range area
'Using Value2 provides a useful speed improvement over Value. On my testing it was 2% on blank cells, up to 10% on non-blanks
X = rngArea.Value2
For lngRow = 1 To rngArea.Rows.Count
For lngCol = 1 To rngArea.Columns.Count
'replace the leading zeroes
X(lngRow, lngCol) = objReg.Replace(X(lngRow, lngCol), vbNullString)
Next lngCol
Next lngRow
'Dump the updated array sans leading zeroes back over the initial range
rngArea.Value2 = X
Else
'caters for a single cell range area. No variant array required
rngArea.Value = objReg.Replace(rngArea.Value, vbNullString)
End If
Next rngArea
'cleanup the Application settings
With Application
.ScreenUpdating = True
.Calculation = lngCalc
.EnableEvents = True
End With
Set objReg = Nothing
End Sub

Related

How to find and format multiple matching words with Regex in Word document using VB script

I have a word document in which I have to do the formatting of the words using VB script. The text can be as follows :
hello <bu ABC bu>, We are pleased to confirm our offer of employment to you. The terms and conditions that will apply to your employment with are set forth in this letter and Exhibit A attached hereto and incorporated herein by reference together, the “Agreement”
You have been offered and accepted the position of , presently reporting to . Your start date is expected to be
The words which are written inside tag needs to be bold and underlined. Currently I have written a VBscript which will find the text given as argument and make it bold and underline as required.
But to make the solution/script more dynamic, I want the script to match Regular Expression pattern which I have written : (?<=(<bu))[a-zA-Z0-9 -:/\[]()]+(?=(bu>))
The script I have written :
Option Explicit
Function Macro1()
Dim strFilePath
strFilePath = "C:\Users\<UserID>\Documents\OfferLetterTemplate.docx"
Dim strTextToReplace
strTextToReplace = "<bu XYZ bu>"
Dim Word, objDoc, objSelection
Set Word = CreateObject("Word.Application")
Word.Visible = True
Dim wordfile
Set wordfile = Word.Documents.Open(strFilePath)
Set objDoc = Word.ActiveDocument
Set objSelection = Word.Selection
objSelection.Find.Forward = True
objSelection.Find.MatchWholeWord = False
objSelection.Find.ClearFormatting
objSelection.Find.Replacement.ClearFormatting
objSelection.Find.Replacement.Font.Bold = True
objSelection.Find.Replacement.Font.Underline = True
objSelection.Find.Text = strTextToReplace
objSelection.Find.Replacement.Text = ""
objSelection.Find.Execute , , , , , , , 0, , , 2
wordfile.save
Word.Quit
End Function
call Macro1
Can someone help me how I can search for the RegEx which I have given above and format all the matching occurrences at once?

how do i extract only 5-digit strings from cells in excel?

I have a bunch of data which contains any number of 5-digit strings in completely inconsistent formats, and i want to extract these 5-digit strings (in bold) out. I am not bothered about strings containing less than or more than 5-digits. as an example, this is the kind of data i have in my file
Cell A1: "1. 76589 - wholesale activities. 2. 33476 - general"
Cell A2: "WHOLESALE ACTIVITIES (76589). SHIPPING (12235). REAL
ESTATE ACTIVITIES (67333)"
Cell A3: "1. 33476 General. 658709 annual road. Unknown 563"
I've tried the usual SEARCH/FIND, MIN, LEFT/RIGHT/MID functions, but am not sure how to get them to produce the result i need, and even text-to-columns wasn't giving me a clean result
thanks in advance
Here is a macro that will split your line into the columns as you requested.
The range being processed is whatever you have selected.
The results are written into the adjacent columns on the same row.
Depending on your worksheet setup, you may want to "clear out" the rows where the results are going before executing the extraction code.
You can also write code to select the data to be processed automatically. Plenty of examples on this forum.
Option Explicit
Sub Extract5Digits()
Dim R As Range, C As Range
Dim RE As Object, MC As Object, M As Object
Dim I As Long
Set R = Selection
Set RE = CreateObject("vbscript.regexp")
With RE
.Global = True
.Pattern = "\b\d{5}\b"
For Each C In R
If .test(C.Text) = True Then
I = 0
Set MC = .Execute(C.Text)
For Each M In MC
I = I + 1
C.Offset(0, I) = M
Next M
End If
Next C
End With
End Sub
Simply with Excel functions this is impossibile.
The best way for you is to use the Regex 55 library in VBA.
Let's consider this example:
+---+--------------------------------------------------------------+
| | A |
+---+--------------------------------------------------------------+
| 1 | Cell A3: "1. 33476 General. 658709 annual road. Unknown 563" |
| 2 | 33476 |
+---+--------------------------------------------------------------+
From the Excel file hit Alt + F11, then go to Tools => Reference and select "Microsoft VBScript Regular Expression 5.5".
Then you can use the following function definition:
Public Function Get5DigitsNumer(search_str As String)
Dim regEx As New VBScript_RegExp_55.RegExp
Dim matches
GetStringInParens = ""
regEx.Pattern = "[0-9]{5}"
regEx.Global = True
If regEx.test(search_str) Then
Set matches = regEx.Execute(search_str)
GetStringInParens = matches(0).SubMatches(0)
End If
End Function
At this time you can use the following code:
Sub PatternExtractor()
Range("A2").Value = Get5DigitsNumer(Range("A1"))
End Sub
which take the value of cell A1 and extract the 5 digits numer, thn the result is saved into cell A2.
At the time I don't have any idea how this code could work where the same cell contains more than one time; like "Cell A1: "1. 76589 - wholesale activities. 2. 33476 - general" in your example.
I suggest you to have a look at this answer. The pattern is different but the question is really similar to yours.
The only way that you can do it is by writing a regex in VBA. I would recommend you to look at this question.

Excel VBA using RegEx for Conditional Formating

I have an Excel 2010 VBA macro that does some conditional formatting over a select area of a spreadsheet. As an example the following snippet searches for a text pattern then colors the cell:
Selection.FormatConditions.Add Type:=xlTextString, String:="TextToMatch", _
TextOperator:=xlContains Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ColorIndex = 36
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
What I would like to add is to match against a regular expression TN[0-9]. A simple match of the string TN followed by a digit.
I have created the RegExp obect:
Dim regEx As Object
Set regEx = CreateObject("VBScript.RegExp")
With regEx
.Pattern = "TN[0-9]"
End With
However I have not figured out how to apply this to the Selection.
As always, thank you for your assistance.
I would recommend using a Static type object for your VBScript.RegExp object.
Cut the range passed into the function down to the Worksheet.UsedRange property. This allows a selection of full columns without calculating empty rows/columns.
Option Explicit
Sub createCFR()
With Selection
'cut Selection down to the .UsedRange so that full row or full
'column references do not use undue calculation
With Intersect(.Cells, .Cells.Parent.UsedRange)
.FormatConditions.Delete
With .FormatConditions.Add(Type:=xlExpression, Formula1:="=myCFR(" & .Cells(1).Address(0, 0) & ")")
.SetFirstPriority
With .Interior
.PatternColorIndex = xlAutomatic
.ColorIndex = 36
.TintAndShade = 0
End With
.StopIfTrue = False
End With
End With
End With
End Sub
Function myCFR(rng As Range)
Static rgx As Object
'with rgx as static, it only has to be created once
'this is beneficial when filling a long column with this UDF
If rgx Is Nothing Then
Set rgx = CreateObject("VBScript.RegExp")
End If
'make sure rng is a single cell
Set rng = rng.Cells(1, 1)
With rgx
.Global = True
.MultiLine = True
.Pattern = "TN[0-9]"
myCFR = .Test(rng.Value2)
End With
End Function
Depending on your Selection, you may need to modify the parameters of the Range.Address property used to create the CFR; e.g. $A1 would be .Address(1, 0).
In the following image, B2:B7 contain =myCFR(A2) filled down to proof the UDF.

MS Word + VBA + RegExp: Get Page Number of Match

Is that possible? Probably not? How can I then find all exact occurrences of a match and the according page numbers?
EDIT:
I have the regex working properly. What I need is for each match to get all the pages it appears on.
Example:
regex = \b\d{3}\b
123 appears on page 1,4,20
243 appear on page 3,5,7
523 appears on page 9
How can I get that information (all the pages a match occurs on?)
This is for creating some kind of index automatically.
EDIT 2:
I got a basic working version, snippet:
Set Matches = regExp.Execute(ActiveDocument.range.Text)
For Each Match In Matches
Set range = ActiveDocument.range(Match.FirstIndex, Match.FirstIndex + Len(Match.Value))
page = range.Information(wdActiveEndAdjustedPageNumber)
The problem is that Match.FirstIndex does not always point to the first character of the match in ActiveDocument.range. Word tables mess this up as ActiveDocument.range.Text contains characters that are not on the text put represent something in the table.
I think this probably fits better in SuperUser.
The answer to the question is "yes."
Selection.Information(wdActiveEndAdjustedPageNumber)
The above property in VBA will get you the page number of a selection.
Also, VBA can do some regular expression work.
This turned out to be rather complex and I can't say if my solution works for any document. The main issue is as indicated in the Question, that RegexMatch.FirstIndex can not be used to determine were the actually Match is within the MS Word Document. This is due to the fact that regex matching is done on range.Text property (String) and that string just contains different amount of characters than the range object does and hence Indexes don't match.
So my solution is for each match, I do a Find in the whole document for that match. the find methods gives a Range object from which the correct page can be determined.
In my special case a match could be the same thing also different value. Example: 343in my case would be the same as Prefix-343. A second issue was that the matches must be sorted eg 123before 324regardless which one occurs first in the document.
If you require the Sort Functionality you will also need the following to "modules":
SortDictionary Function:
http://www.cpearson.com/excel/CollectionsAndDictionaries.htm
Module "modQSortInPlace":
http://www.cpearson.com/Zips/modQSortInPlace.zip
If no sort is needed you don't need them but you need to remove the according function call SortDictionary Dict, Truefrom my code.
Now to my code. Soem parts you can remove, especially the formatting one. This is specific to my case. Also if your match is "unique", eg. not prefix or so you can simplify the code too. You will need to reference the "Microsoft Scripting Library".
Option Explicit
Sub ExtractRNumbers()
Dim Dict As Scripting.Dictionary
Set Dict = CreateObject("Scripting.dictionary")
Dim regExp, Match, Matches
Dim rNumber As String
Dim range As range
Set regExp = CreateObject("VBScript.RegExp")
regExp.Pattern = "\b(R-)?\d{2}-\d{4,5}(-\d)?\b"
regExp.IgnoreCase = False
regExp.Global = True
' determine main section, only extract R-Numbers from main section
' and not the Table of contents as example
' main section = section with most characters
Dim section As section
Dim maxSectionSize As Long
Dim sectionSize As Long
Dim sectionIndex As Integer
Dim currentIndex As Integer
maxSectionSize = 0
currentIndex = 1
For Each section In ActiveDocument.Sections
sectionSize = Len(section.range.text)
If sectionSize > maxSectionSize Then
maxSectionSize = sectionSize
sectionIndex = currentIndex
End If
currentIndex = currentIndex + 1
Next
Set Matches = regExp.Execute(ActiveDocument.Sections(sectionIndex).range.text)
For Each Match In Matches
' If the Document contains Tables, ActiveDocument.range.Text will contain
' BEL charachters (chr(7)) that probably define the table structure. The issue
' is that then Match.FirstIndex does not point to the actual first charachter
' of a Match in the Document.
' Also there are other things (unknwon) that lead to the same issue, eg.
' Match.FirstIndex can not be used to find the actual "matching word" within the
' document. Because of that below commented apporach does not work on a generic document
' Set range = ActiveDocument.range(Match.FirstIndex, Match.FirstIndex + Len(Match.Value))
' page = range.Information(wdActiveEndAdjustedPageNumber)
' Maybe there is a simpler solution but this works more or less
' the exception beign tables again. see http://support.microsoft.com/kb/274003
' After a match is found the whole document is searched using the find method.
' For each find result the page number is put into an array (if it is not in the array yet)
' Then the match is formatted properly.
' After formatting, it is checked if the match was previously already found
'
' If not, we add a new entry to the dictionary (key = formatted match, value = array of page numbers)
'
' If match was already found before (but potentially in a different format! eg R-87-1000 vs 87-1000 as example),
' all additional pages are added to the already found pages.
Set range = ActiveDocument.Sections(sectionIndex).range
With range.Find
.text = Match.Value
.MatchWholeWord = True
.MatchCase = True
.Wrap = wdFindStop
End With
Dim page As Variant
Dim pages() As Integer
Dim index As Integer
index = 0
ReDim pages(0)
Do While range.Find.Execute() = True
page = range.Information(wdActiveEndAdjustedPageNumber)
If Not IsInArray(page, pages) Then
ReDim Preserve pages(index)
pages(index) = page
index = index + 1
End If
Loop
' FORMAT TO PROPER R-NUMBER: This is specific to my case
rNumber = Match.Value
If Not rNumber Like "R-*" Then
rNumber = "R-" & rNumber
End If
' remove possible batch number as r-number
If Len(rNumber) > 11 Then
rNumber = Left(rNumber, Len(rNumber) - 2)
End If
' END FORMAT
If Not Dict.Exists(rNumber) Then
Dict.Add rNumber, pages
Else
Dim existingPages() As Integer
existingPages = Dict(rNumber)
For Each page In pages
If Not IsInArray(page, existingPages) Then
' add additonal pages. this means that the previous match
' was formatted different, eg R-87-1000 vs 87-1000 as example
ReDim Preserve existingPages(UBound(existingPages) + 1)
existingPages(UBound(existingPages)) = page
Dict(rNumber) = existingPages
End If
Next
End If
Next
'sort dictionary by key (R-Number)
SortDictionary Dict, True
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim stream
' Create a TextStream.
Set stream = fso.CreateTextFile(ActiveDocument.Path & "\" & ActiveDocument.Name & "-rNumbers.txt", True)
Dim key As Variant
Dim output As String
Dim i As Integer
For Each key In Dict.Keys()
output = key & vbTab
pages = Dict(key)
For i = LBound(pages) To UBound(pages)
output = output & pages(i) & ", "
Next
output = Left(output, Len(output) - 2)
stream.WriteLine output
Next
Set Dict = Nothing
stream.Close
End Sub
Private Function IsInArray(page As Variant, pages As Variant) As Boolean
Dim i As Integer
IsInArray = False
For i = LBound(pages) To UBound(pages)
If pages(i) = page Then
IsInArray = True
Exit For
End If
Next
End Function

How to match a simple number pattern in VBA using RegEx [closed]

Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Closed 9 years ago.
Questions asking for code must demonstrate a minimal understanding of the problem being solved. Include attempted solutions, why they didn't work, and the expected results. See also: Stack Overflow question checklist
Questions concerning problems with code you've written must describe the specific problem — and include valid code to reproduce it — in the question itself. See SSCCE.org for guidance.
Improve this question
How do I check if a string is either a one digit number OR a two digit number and otherwise return false?
How about:
Function OneOrTwo(i As Integer) As Boolean
Dim objRegEx As Object
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.IgnoreCase = True
objRegEx.Global = True
objRegEx.Pattern = "^\d{1,2}$"
OneOrTwo = objRegEx.Test(i)
End Function
See: http://msdn.microsoft.com/en-us/library/ms974570.aspx
You can also do this using VBA LIKE:
Function OneOrTwo(Digits As Variant) As Boolean
OneOrTwo = Digits Like "#" Or Digits Like "##"
End Function
IF CInt(myNumberString) < 100 Then
MsgBox "String must be either 1 or 2 digits"
Else
Msgbox "Failed"
End IF
Should work for you.
Remou had it right. Here is a RegexContains function so you can use it with all sorts of patterns, not just the one you need now.
Function RegexContains(ByVal find_in As String, _
ByVal find_what As String, _
Optional IgnoreCase As Boolean = False) As Boolean
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = find_what
RE.IgnoreCase = IgnoreCase
RE.Global = True
RegexContains = RE.Test(find_in)
End Function
Following the example from Remou, assuming the cell is A1, you'd write:
=RegexContains(A1, "^\d{1,2}$")
Here is what I would try. /d for digit, ? for option 2 digits.
/d/d?
or
/d{1,2}