I have a workbook with about 30 worksheets. I want to delete column 4 only in worksheets that contain the text"NIFTY".
Sub FindERROR() Dim SearchString As String Dim SearchRange As Range, cl As Range Dim FirstFound As String Dim sh As Worksheet ' Set Search value SearchString = "NIFTY" Application.FindFormat.Clear loop through all sheets For Each sh In ActiveWorkbook.Worksheets Columns(4).Delete End Sub
I couldnt get the VBA code to run
Related
Trying to get Column F/VENDOR # to populate the vendor number only. The vendor number are highlighted. My strategy is from the right, find the third "_" and substitute it with a "|". Then anything right of the pipe is populated in column D.
However the ones with more than three "_" are not following the logic. What am I doing wrong?
Column D formula =IF(ISERROR(FIND("_",C2)),"",RIGHT(C2,LEN(C2)-FIND("|",SUBSTITUTE(C2,"_","|",LEN(C2)-LEN(SUBSTITUTE(C2,"_","",3))))))
Column F/Vendor# formula =IF(ISERROR(LEFT(D2,FIND("_",D2)-1)),"",LEFT(D2,FIND("_",D2)-1))
The issue is in the column D formula - you have:
...LEN(C2)-LEN(SUBSTITUTE(C2,"_","",3))...
It should be:
...LEN(C2)-LEN(SUBSTITUTE(C2,"_",""))-2...
Giving a full formula for column D of:
=IF(ISERROR(FIND("_",A17)),"",RIGHT(A17,LEN(A17)-FIND("|",SUBSTITUTE(A17,"_","|",LEN(A17)-LEN(SUBSTITUTE(A17,"_",""))-2))))
The reason is because that part of the formula is really being used to calculate an index in another SUBSTITUTE function. You need to use a relative offset (-2 is kind of 3rd from right) if you have a unknown number of _s in the string.
If you can use VBA then you should look at using an UDF with regular expressions as I feel this is slightly less complex than the double-formula method which is not trivial to step through. The UDF could simply be this:
Option Explicit
Function GetVendorNumber(rng As Range) As String
Dim objRegex As Object
Dim objMatches As Object
GetVendorNumber = ""
Set objRegex = CreateObject("VBScript.RegExp")
With objRegex
.Pattern = "\D+_(\d+)_.+"
Set objMatches = .Execute(rng.Text)
If objMatches.Count = 1 Then
GetVendorNumber = objMatches(0).SubMatches(0)
End If
End With
End Function
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.
Below is part of my code for a small webscraping project I'm working on. I'm having an issue inserting the values of the second Regex into the datagrid and have them line up with the values of the first regex. Each page will have a list of ten items, each with a unique ID along with a format and a rating. When the code is run, it only adds the formatID data to the first ten rows.
Dim r As New System.Text.RegularExpressions.Regex("<div id=""R.*"" class=""a-section review"">")
Dim Matches As MatchCollection = r.Matches(SourceCode)
For Each ItemID As Match In Matches
DataGridView1.Rows.Add("", Split(ItemID.Value, """").GetValue(1), AsinTextBox.Text, "", "", "", "")
Next
Dim R2 As New System.Text.RegularExpressions.Regex("<a class=""a-size-mini a-link-normal a-color-secondary"" href=""/.*/product-reviews/.*/ref=.*"">.*</a>")
Dim Matches2 As MatchCollection = R2.Matches(SourceCode)
Dim Z2
Dim i As Integer = 0
For Each FormatID As Match In Matches2
i = i + 1
Z2 = Split(FormatID.Value, ">").GetValue(1)
Z2 = Split(Z2, "<").GetValue(0)
DataGridView1.Rows(i).Cells(5).Value = (Z2)
Next
I figured it out. Instead of doing multiple Regex searches, I did one larger one that incorporated all of the three that I was trying to do previously. The three regex searches from before were all apart of one large string of html and after I had searched for it I used the split function to get the correct value for Z2.
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
I have a file that has been generated by a server - I have no control over how this file is generated or formatted. I need to check each line begins with a string of set length (in this case 21 numerical chars). If a line doesn't match that condition, I need to join it to the previous line and, after reading and correcting the whole file, save it. I am doing this for a lot of files in a directory.
So far I have:
Dim rgx As New Regex("^[0-9]{21}$")
Dim linesList As New List(Of String)(File.ReadAllLines(finfo.FullName))
If linesList(0).Contains("BlackBerry Messenger") Then
linesList.RemoveAt(0)
For i As Integer = 0 To linesList.Count
If Not rgx.IsMatch(i.ToString) Then
linesList.Concat(linesList(i-1))
End If
Next
End If
File.WriteAllLines(finfo.FullName, linesList.ToArray())[code]
There's a for statement before and after that code block to loop over all files in the source directory, which works fine.
Hope this isn't too bad to read :/
I didn't think your solution was any good, you were failing on concatenating the lines. Here's a different approach:
Dim rgx As New Regex("^[0-9]{21}")
Dim linesList As New List(Of String)(File.ReadAllLines(finfo.FullName))
' We will create a new list to store the new lines data
Dim newLinesList As New List(Of String)()
If linesList(0).Contains("BlackBerry Messenger") Then
Dim i As Integer = 1
Dim newLine As String
While i < linesList.Count
newLine = linesList(i)
i += 1
' Keep going until the "real" line is over
While i < linesList.Count AndAlso Not rgx.IsMatch(linesList(i))
newLine += linesList(i)
i += 1
End While
newLinesList.Add(newLine)
End While
End If
File.WriteAllLines(finfo.FullName, newLinesList.ToArray())