I have a range (rng) which has the word "means" somewhere in it. I'm trying to determine if a word two words before "means" is underlined but can't quite figure out how.
Here's what my rng.Text is (note the brackets indicate the underlined text)
"[Automobile] - means a car that isn't a bus but can be an SUV"
Sometimes, it is "The way you have to go about it is with the various means of thinking".
The first one is a definition, since it has "means" preceeded by an underlined word. The second example is NOT a definition.
I'm trying to get my macro to look to 2 word before "means", but can't quite figure out how.
I am able to figure how many characters it is by this:
Dim meansLoc&
meansLoc = instr(rng.Text, "means")
Then, I can test If rng.Characters(meansLoc-9).Font.Underline = wdUnderlineSingle, but I run into problems if my defined word is only say 3 characters ("Dad - means a father", would error our since there means' index is 7, and 7-9 = -2). This is why I'd like to use words. (I can use one or two words before "means").
How can I return the character index of "means" in my rng. How do I get the "word index" (i.e. 2) from my rng?
Both Characters and Words are ranges, so one approach would be to compare the Start of the Character's range with each Word in the rng, e.g. you could start with
' assumes you have already declared and populated rng
Dim bDefinition As Boolean
Dim i as Integer
Dim meansLoc as Integer
Dim meansStart as Integer
meansLoc = instr(rng.Text,"means")
meansStart = rng.Characters(meansLoc).Start
bDefinition = False
For i = 1 To rng.Words.Count
If rng.Words(i).Start = meansStart Then ' i is your Word index (i.e. 3, not 2!)
If i > 2 Then
If rng.Words(i - 2).Font.Underline = wdUnderlineSingle Then
Debug.Print "Looks like a definition"
bDefinition = True
Exit For
End If
End If
End If
Next
If Not bDefinition Then
Debug.Print "Couldn't see a definition"
End If
Just bear in mind that what Word considers to be a "word" may be different from your normal understanding of what a "word" is.
Related
I am trying to do some conditional formatting in word table based on the value in a specific cell.
If the value is <1 set the background to green; if the value is between 1 and 10, format the background yellow and if the value is above 10 format the background red.
I am able to loop through a table and debug.print the content of each cell but am struggling with checking for the datatype in the correspoding cell.
I tried IsNumeric, Int, Fix but none work
`
Sub ConditionalFormat()
Dim tbl As Table, r As Long, c As Long
Set tbl = ActiveDocument.Tables(1)
For r = 1 To tbl.Rows.Count
For c = 1 To tbl.Columns.Count
If tbl.Cell(r, c) = Int(tbl.Cell(r, c)) Then
tbl.Cell(r, c).Shading.BackgroundPatternColor = wdColorBlueGray
End If
Next c
Next r
End Sub
where am i going wrong?
`
Word tables have "end of cell" characters that can get in the way when you process a cell's content.
In your case,
Int(tbl.Cell(r,c))
won't work because tbl.Cell(r,c) returns the Cell, not its value or content. To get its content, you really need
tbl.Cell(r.c).Range
But even that just specifies a block of material in the cell, so it might contain text, images etc. What you are typically looking for is the plain text of the cell, which is really
tbl.Cell(r.c).Range.Text
So you might hope that, for example, if your cell contained the text "42" the expression
IsNumber(tbl.Cell(r.c).Range.Text)
would return True. But it doesn't, because each Word table cell has an end-of-cell character that is returned at the end of the .Range.Text, and that means VBA does not recognise the text as Numeric. To deal with that, you can use
Dim rng As Word.Range
Set rng = tbl.Cell(r.c).Range
rng.End = rng.End - 1
Debug.Print IsNumber(rng.Text)
Set rng = Nothing
SOme VBA functions will ignore the end-of-cell marker anyway as they are intended to be reasonably flexible about how to recognise a number, e.g. you should be able to use
Val(tbl.Cell(r,c).Range.Text)
without running into problems.
As for which functions to use to test/convert the value, that really depends on how much you can assume about your data, how much validation you need to do and what you need to do with your data.
In a nutshell, Val looks for "bare numbers", e.g. 123, 123.45, and numbers in scientific notation. If it finds something non-numeric it will return 0. AFAICR Int and Fix work in similar ways but modify the number in different ways. IsNumeric, CInt, CDbl and so on recognise numbers taking account of the Regional Settings in your OS (e.g. Windows) and accepts/ignores grouping digits (e.g. so they might recognize 1,234,567.89 and even 1,,234,567.89 as 1234567.89 on a typical US system and 1.234.567,89 as the "same number" on a German system). CInt etc. will raise an error if they don't recognise a number.
Anything more than that and you'll probably have to find or write a piece of code that does exactly what you need. I expect there are thousands of such routines out there.
Probably worth noting that the Range objects in Excel and Word have different members. Excel has a Range.Value property but Word does not.
Try:
Sub ConditionalFormat()
Dim r As Long, c As Long
With ActiveDocument.Tables(1)
For r = 1 To .Rows.Count
For c = 1 To .Columns.Count
With .Cell(r, c)
Select Case Val(Split(.Range.Text, vbCr)(0))
Case Is < 1: .Shading.BackgroundPatternColor = wdColorGreen
Case Is > 10: .Shading.BackgroundPatternColor = wdColorRed
Case Else: .Shading.BackgroundPatternColor = wdColorYellow
End Select
End With
Next c
Next r
End With
End Sub
I had been in a situation in which I need to select particular text in two lines. I had been doing this by the following code:
Selection.Paragraphs(1).Range.Select
Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
But the above code is not applicable to all four following scenarios. I'm in search of code which would output selection of first line and second line till 'comma'. I need code as simple as possible, kindly help.
Scenario 1
Infraestructura Energetica Nova SAB De CV
IENOVA* MM, Buy
Scenario 2
Infraestructura Energetica Nova SAB De CV
IENOVA13 MM, Sell
Scenario 3
Infraestructura Energetica Nova SAB De CV
IENOVA* MM
Scenario 4 Edited
Nova SAB
IENOVA MM
Illustration with Picture:
The following works with the two paragraphs as separate ranges. The first paragraph is picked up unaltered and used as the starting point for getting the second paragraph.
Using the Instr function, it determines whether a comma is present - Instr returns 0 if there is none, otherwise a positive number.
If there is no comma, the paragraph mark is cut off. It's not clear whether you want this Chr(13), if you do, just comment out that line and the paragraph is picked up with no changes.
If there is a comma, the Range is collapsed to its starting point, then extended to the position of the comma, minus 1 (leaves out the comma).
The two strings are then concatenated for debug.print. And then the endpoint of the first Range is extended to the end point of the second Range, so that you have one Range (if that's what you need - that's not clear).
Sub SelectInfo()
Dim rngLine1 As Word.Range
Dim rngLine2 As Word.Range
Dim isComma As Long
Set rngLine1 = Selection.Range.Paragraphs(1).Range
Set rngLine2 = rngLine1.Duplicate
rngLine2.Collapse (wdCollapseEnd)
Set rngLine2 = rngLine2.Paragraphs(1).Range
isComma = InStr(rngLine2.Text, ",")
If isComma = 0 Then
'No comma, assume we don't want the last paragraph mark...
rngLine2.MoveEnd wdCharacter, -1
Else
rngLine2.Collapse wdCollapseStart
rngLine2.MoveEnd wdCharacter, isComma - 1
End If
Debug.Print rngLine1.Text & rngLine2.Text
'Get a single Range instead of the string:
rngLine1.End = rngLine2.End
End Sub
Taking your question literally:
...I'm in search of code which would output selection of first line and second line till 'comma'.
You can make an adjustment to the 2nd line of your code as follows;
Selection.Paragraphs(1).Range.Select
Selection.MoveEndUntil ",", wdForward
What this does is moves the end of the selection forward until it finds ",".
If however, per your 'Scenarios', some of the selections may not contain a comma, the following will work:
Sub SelectionTest()
Dim mySel As String
With Selection
.Paragraphs(1).Range.Select
mySel = Selection
If InStr(1, mySel, ",") Then
.MoveEndUntil ",", wdForward
Else
.Extend "M"
.Extend "M"
End If
End With
End Sub
What this does is selects the paragraph, sets the string to the variable mySel and using the InStr function tests if the string contains a comma, if it does, it executes the same code as above, but if there is no comma, it extends the selection until the character "M" (upper case M) and then extends the selection again to the next "M".
As indicated in your comment the "MM" part of your text is a variable so:
Sub SelectionTest()
Dim mySel As String
With Selection
.Paragraphs(1).Range.Select
.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
mySel = Selection
If InStr(1, mySel, ",") Then
.Paragraphs(1).Range.Select
.MoveEndUntil ","
Else: Exit Sub
End If
End With
End Sub
What this does is selects the first paragraph and then extends the selection to the end of the 2nd line, sets selected text to the variable mySel and using the InStr function tests if the string contains a comma, if it does, it executes the same code as above, but if there is no comma, it keeps the 2 lines selected and that's it.
This keeps code shorter rather than having an ElseIf statement for each Country ("MM", "RO", "TI" etc) but does rely on no text after the Country code. Otherwise follow the previous part of the answer and repeat the ElseIf for each Country variable.
I tested this on all of your scenarios (by copy/pasting your scenario paragraphs into word) and each one resulted the same as your 'target selection' as long as the cursor was at the start of the required paragraph when the code was run.
Alternatively you can omit the part specifying the comma and just use (perhaps adjust as required and put this within an if statement to allow for your variables):
With Selection
.Paragraphs(1).Range.Select
.Extend "M"
.Extend "M"
End With
These codes will work based on what you've asked and provided in your question but may not be the most universal code in it's current form.
There is some more info on the functions and methods used in the below links:
Selection.MoveEndUntil
Selection.Extend
InStr
Selection.MoveDown
I'm trying to automate certain functions in an Excel file.
Here is my issue:
Table 1 contains a string is Column "Info", followed by two empty cells. For each of the rows in Table 1, I want to check if a value of Table 2, Column "Fruit" exists in column "Info" of Table 1. If so, I would like to fill in the "Color" and "Price" of Table 2 in the empty cells in Table 1.
For example, the second row contains the word "bananas", which means "Color" "Yellow" and "Price" "15" should be filled in the same columns in Table 1, row 2.
Somehow this issue seems so simple to me, but when I start to think of how to implement this, I get stuck. So unfortunately, I don't have any code available to fix. I just hope this issue isn't too vague.
I've also tried solving this issue using formulas, using MATCH and INDEX, but I couldn't get that to work either.
Here's a function that will return the row in the ListObject (Table) where the first matching word is found.
Public Function MatchFruit(ByVal sInfo As String, ByRef rFruit As Range) As Long
Dim vaSplit As Variant
Dim i As Long, j As Long
Dim rFound As Range
Dim sWhat As String
vaSplit = Split(sInfo, Space(1))
For i = LBound(vaSplit) To UBound(vaSplit)
'strip out non-alpha characters
sWhat = vbNullString
For j = 1 To Len(vaSplit(i))
If Asc(Mid(LCase(vaSplit(i)), j, 1)) >= 97 And Asc(Mid(LCase(vaSplit(i)), j, 1)) <= 122 Then
sWhat = sWhat & Mid(vaSplit(i), j, 1)
End If
Next j
'find the word in the range
Set rFound = Nothing
Set rFound = rFruit.Find(sWhat, , xlValues, xlWhole, , , False)
If Not rFound Is Nothing Then 'if it's found
'return the row in the ListObject
MatchFruit = rFound.Row - rFruit.ListObject.HeaderRowRange.Row
'stop looking
Exit For
End If
Next i
End Function
Assuming your first table is called tblData and your second table tblFruit, you would get the color using
=INDEX(tblFruit[Color],MatchFruit([#Info],tblFruit[Fruit]))
and the price similarly
=INDEX(tblFruit[Price],MatchFruit([#Info],tblFruit[Fruit]))
Long Explanation
The vaSplit assignment line uses the Split function to convert a string into an array based on a delimiter. Since your sample data was sentences, the normal delimiter is a space to split it into words. A string like
This is some line about apples.
is converted to an array
vaSplit(1) This
vaSplit(2) is
vaSplit(3) some
vaSplit(4) line
vaSplit(5) about
vaSplit(6) apples.
Next, the For loop goes through every element in the array to see if it can find it in the other list. The functions LBound and Ubound (lower bound and upper bound) are used because we can't be sure how many elements the array will have.
The first operation inside the loop is to get rid of any extraneous characters. For that, we create the variable sWhat and set it to nothing. Then we loop through all the characters in the element to see if any are outside of the range a...z. Basically, anything that's a letter gets appended to sWhat and anything that's not (a number, a space, a period) doesn't. In the end sWhat is the same as the current element with all non-alpha characters stripped out. In this example, we'd never match apples. because of the period, so it's stripped away.
Once we have a good sWhat, we now use the Find method to see if that word exists in the rFruit range. If it does, then rFound will not be Nothing and we move ahead.
Note that if it doesn't find the word in the range, then rFound will be Nothing and the function will return zero.
If the word is found, the function returns the row it was found on less the row where the ListObject starts. That way the function returns what row it is withing the data of the ListObject not on the worksheet. This is useful when incorporating into an INDEX formula. To make a formula return something, you assign that something to the formula's name.
Finally, the Exit For line simply stops looking through the array once a match was found. If you have more than one match in your data, it will only return the first one.
Troubleshooting
The most likely error that you'll find is that the function will return zero when you expect it to return a row number. That most likely means it did not find any words in the list.
If you're certain that both lists contain a matching word, here's how you troubleshoot it: After the Set rFound = line put a Debug.Print statement.
Set rFound = rFruit.Find(sWhat, , xlValues, xlWhole, , , False)
Debug.Print "." & sWhat & "."
If Not rFound Is Nothing Then 'if it's found
That will print sWhat to the Immediate Window (Ctrl+G in the VBE to see the Immediate Window). The periods around the word are so you can see any non-printable characters (like spaces). If you try to match .pears . with pears it won't match because the first one has a space at the end - and you can see that because we stuck periods before and after.
If spaces are going to be a problem, you can use the Trim$() function on sWhat to get rid of them first.
With that Debug.Print statement, you might see results like
.paers.
in which case would recognize that you have a typo.
To Dick and other people who may be interested. Like I mentioned in my last comment on the answer provided by #Dick-Kusleika, his answer didn't fully cover my initial question. Even though it gave me great insight and it did the job of filling the empty cells with the appropriate data, I was really looking for something that would do it automatically, without me having to copy-paste any formulas. So I spent some more time trying to figure it out, getting info from the internet and sparring with a colleague who shares my interest in this. And eventually I managed to get it working! (hurray!!)
Below is my solution. As I'm still a beginner, I probably did a few things that could have been done better or cleaner. So I'm really interested in your opinion about this and would love to hear any remarks or tips.
Sub check_fruit()
Dim ws As Excel.Worksheet
Dim lo_Data As Excel.ListObject
Dim lo_Fruit As Excel.ListObject
Dim lr_Data As Excel.ListRow
Dim lr_Fruit As Excel.ListRow
Dim d_Info As Variant
Dim f_Fruit As Variant
Set ws = ThisWorkbook.Worksheets("Exercise")
Set lo_Data = ws.ListObjects("tblData")
Set lo_Fruit = ws.ListObjects("tblFruit")
For Each lr_Data In lo_Data.ListRows
'check if field "Color" is empty in tblData'
If IsEmpty(Intersect(lr_Data.Range, lo_Data.ListColumns("Color").Range).Value) Then
d_Info = Intersect(lr_Data.Range, lo_Data.ListColumns("Info").Range).Value
For Each lr_Fruit In lo_Fruit.ListRows
f_Fruit = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Fruit").Range).Value
'check for each row in tblFruit if value for field "Fruit" exists in field "Info" of tblData'
If InStr(1, d_Info, f_Fruit, vbTextCompare) <> 0 Then
Intersect(lr_Data.Range, lo_Data.ListColumns("Color").Range).Value = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Color").Range).Value
Intersect(lr_Data.Range, lo_Data.ListColumns("Price").Range).Value = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Price").Range).Value
End If
Next lr_Fruit
End If
Next lr_Data
End Sub
I need to write a macro that will replace specific characters in a selected string with other specific characters. That is, for example, I may want to replace all a's with b's, all b's with c's, and so on.
I wrote this test macro just to see if I could replace characters. It gets stuck in an infinite loop replacing the first character in the selection with "1".
Dim obChar As Range 'Define a range variable
For Each obChar In Selection.Characters
obChar.Text = "1"
Next obChar
What am I doing wrong?
Try a reversed loop:
Dim i As Integer
For i = Selection.Characters.Count To 1 Step -1
Selection.Characters(i).Text = "1"
Next i
I am creating documents using VBA in Word with data being pulled from Excel. Unfortunately the titles are sometimes so long that they get wrapped in Word.
I need the titles to remain on one line. I plan on doing this by simply changing the font size until the text fits on one line.
Searching for solutions to this problem I have come accross .ComputeStatistics(wdStatisticLines).
Unfortunately when I run this code, it keeps on telling me that there are 0 lines to my text. How can I get the code to give the correct number of lines?
Here is my code so far (only the relevant section):
'Set document title
Dim sLength As Integer
Dim rStatTitle As Range
Set rStatTitle = wkb.Worksheets("Daten2").Range("nfStatTitle") 'Fund Title
With tblTitle.cell(2, 1)
.Range.Text = rStatTitle.Cells(1, 1)
Do Until .Range.ComputeStatistics(wdStatisticLines) <= 1
sLength = Len(rStatTitle.Cells(1, 1))
.Range.Font.Size = .Range.Font.Size - 1
Loop
End With
FYI: tblTitle is a word table and is declared as such further up in the code.
This page says you should shrink your Range so it excludes the end-of-cell marker.
Dim newRange As Range
With tblTitle.cell(2, 1)
.Range.Text = rStatTitle.Cells(1, 1)
Set newRange = .Range
newRange.End = newRange.End -1
Do Until newRange.ComputeStatistics(wdStatisticLines) <= 1