Context: I'm writing a Word VBA macro that loops through each word in a document, identifies the acronyms, and creates an acronym list as a new document. The next step is to identify whether the acronym is in parentheses (meaning it's likely spelled out) on its first occurrence. So, I'd like to expand the range to find out whether the characters on either side of the word are "(" and ")".
Issue: I can't figure out how to assign the range of the word to a range variable that I can then expand. Using "rngWord = ActiveDocument.Words(k)" (where k is the counter variable) gets the error #91, Object Variable or With block variable not set. So presumably there's a method or property for Words that I'm missing. Based on Microsoft's VBA reference, though, the members of the Words collection are already ranges, so I'm stumped on why I can't assign one to a range variable.
Dim intArrayCount As Integer
Dim booAcroMatchesArray As Boolean
Dim intNextAcro As Integer
Dim strAcros(1000) As String
Dim strContext(1000) As String
Dim booAcroDefined(1000) As Boolean
Dim strTestMessage As String
i = 1
booAcroMatchesArray = False
intNextAcro = 1
For k = 1 To ActiveDocument.Words.Count
strWord = ActiveDocument.Words(k).Text
rngWord = ActiveDocument.Words(k) //The line that's missing something
MsgBox strWord
rngWord.Expand Unit:=wdCharacter
strWordPlus = rngWord
MsgBox strWordPlus
strWord = Trim(strWord)
If strWord = UCase(strWord) And Len(strWord) >= 2 And IsLetter(Left(strWord, 1)) = True Then
'MsgBox ("Word = " & strWord & " and Length = " & Len(strWord))
For intArrayCount = 1 To 1000
If strWord = strAcros(intArrayCount) Then booAcroMatchesArray = True
Next intArrayCount
'MsgBox ("Word = " & strWord & " Match = " & booAcroMatchesArray)
If booAcroMatchesArray = False Then
strAcros(intNextAcro) = strWord
intNextAcro = intNextAcro + 1
End If
booAcroMatchesArray = False
End If
Next k
Object variables need to be assigned using Set. Instead of:
rngWord = ActiveDocument.Words(k)
use
Set rngWord = ActiveDocument.Words(k)
This small sample worked correctly:
Sub WordRangeTest()
Dim rngWord As Range
Set rngWord = ActiveDocument.Words(1)
MsgBox (rngWord.Text)
End Sub
Related
I want to write a Word macro that counts words in an active document section including footnote text.
This method works correctly when applied to the entire document:
SectionWordCount = ActiveDocument.ComputeStatistics(Statistic:=wdStatisticWords, _
IncludeFootnotesAndEndnotes:=True)
I can count words in an active section without the footnote text when this method, without the Include argument, is applied to a range defined as the active section:
SectionNum = Selection.Information(wdActiveEndSectionNumber)
Set myRange = ActiveDocument.Sections(SectionNum).Range
SectionWordCount = myRange.ComputeStatistics(Statistic:=wdStatisticWords)
However, this method fails when I attempt to set the Include argument true:
SectionNum = Selection.Information(wdActiveEndSectionNumber)
Set myRange = ActiveDocument.Sections(SectionNum).Range
SectionWordCount = myRange.ComputeStatistics(Statistic:=wdStatisticWords, _
IncludeFootnotesAndEndnotes:=True)
This provokes 'Run-time error 448: Named argument not found.'
Does anyone have a fix or work around in a macro that will provide the word count including footnotes for the active document section?
A Workaround That Has Its Own Error
Having seen no response, I will add this attempted workaround. Since the IncludeFootnotesAndEndnotes flag seems inoperable with a text range encompassing the active section, I extended the macro to iterate through each document footnote and add those individual footnote word counts to the total for the section. However, this encounters an issue that the footnotes subject to iteration are not limited to footnotes within the active section, so that the final word count captures all document footnotes (it overcounts).
So, how can I limit the iteration to just the footnotes within the active section?
This is the revised macro:
Sub SectionWordCount()
Dim SectionWordCount As Integer
Dim SectionNum As Integer
Dim f As Footnote
Dim fTempCount As Integer
SectionWordCount = 0
SectionNum = 0
fTempCount = 0
SectionNum = Selection.Information(wdActiveEndSectionNumber)
Set myRange = ActiveDocument.Sections(SectionNum).Range
SectionWordCount = myRange.ComputeStatistics(Statistic:=wdStatisticWords)
' Now get word count in each footnote and accumulate in <fTempCount>
For Each f In myRange.Footnotes
' For some reason Word is iterating over entire document (all footnotes) rather than those associated with the active section.
fTempCount = fTempCount + f.Range.ComputeStatistics(Statistic:=wdStatisticWords)
Next
SectionWordCount = SectionWordCount + fTempCount
MsgBox "Section " & SectionNum & vbCrLf & _
"The current section has " & SectionWordCount & " words including footnotes."
End Sub
Revised and working macro
Sub SectionWordCount()
Dim SectionWordCount As Integer
Dim SectionNum As Integer
Dim f As Footnote
Dim fTempCount As Integer
SectionWordCount = 0
SectionNum = 0
fTempCount = 0
SectionNum = Selection.Information(wdActiveEndSectionNumber)
Set myRange = ActiveDocument.Sections(SectionNum).Range
SectionWordCount = myRange.ComputeStatistics(Statistic:=wdStatisticWords)
If myRange.Footnotes.Count > 0 Then
For idx = 1 To myRange.Footnotes.Count
Set f = myRange.Footnotes(idx)
fTempCount = fTempCount + f.Range.ComputeStatistics(Statistic:=wdStatisticWords)
Next
End If
SectionWordCount = SectionWordCount + fTempCount
MsgBox "Section " & SectionNum & vbCrLf & _
"The current section has " & SectionWordCount & " words including footnotes."
End Sub
IncludeFootnotesAndEndnotes is only available on document-level (https://learn.microsoft.com/de-de/office/vba/api/word.document.computestatistics) but not on range-level (https://learn.microsoft.com/de-de/office/vba/api/word.range.computestatistics)
There seems to be a bug in VBA.
You have to iterate footnotes by index not via the collection:
' Now get word count in each footnote and accumulate in <fTempCount>
If myrange.Footnotes.Count > 0 Then
For i = 1 To myrange.Footnotes.Count
Set f = myrange.Footnotes(i)
' For some reason Word is iterating over entire document (all footnotes) rather than those associated with the active section.
fTempCount = fTempCount + f.Range.ComputeStatistics(Statistic:=wdStatisticWords)
Next
end if
```
I have two sheets, one that information about decks played by players, who owns it, what the deck name is, and earlier names. Then another where I have match information of said player, owner and deck name.
My aim is to update match information deck names to newest. I've these two subprocedures. First finds what we need to update, then uses a filtering subprocedure to filter the match list to only have matches containing the player, owner and deck combination visible.
Then it calls the other method, where I try to update the name. It runs nicely, says happily in the debug log that it has beeen renamed from oldname to new name, but when it's finished, the value in the deck name cell remains unchanged.
What am I doing wrong?
EDIT: I tried out your script, Pefington, and amended the split of for i and for each loops. I also used the Variant approach you suggested. Now it runs again, and says it tries to update 'chulane precon to chulane', but that change is not reflected in the excel sheet.
Had to do an rather ugly way of populating the array of Variants with from the array of Strings.
I also added a rownumber to just check in debugger that it indeed goes through the row with chulane precon, and it does, but still fails to actually save the chulane into the cell. Which is the thing I need help with. :)
Sub CleanOldDeckNames()
' DISABLE EXCEL ANIMATIONS
Application.ScreenUpdating = False
Dim player As String
Dim owner As String
Dim concatenatedOldNames As String
Dim oldNamesArray() As Variant
Dim currentName As String
Dim currentOldName As String
Dim temporaryOldNameStringArray() As String
Dim j As Integer
Dim oldName As Variant
Sheets("Decklist").Select
Call dl_search_deck_hidden_reset
For i = 12 To 50
player = ActiveWorkbook.Worksheets("Decklist").range("A" & i).Value
owner = ActiveWorkbook.Worksheets("Decklist").range("B" & i).Value
currentName = ActiveWorkbook.Worksheets("Decklist").range("C" & i).Value
concatenatedOldNames = ActiveWorkbook.Worksheets("Decklist").range("D" & i).Value
If Not (StrComp(concatenatedOldNames, "") = 0) Then
temporaryOldNameStringArray = Split(concatenatedOldNames, ",")
j = 0
For Each oldNameToBeConverted In temporaryOldNameStringArray
ReDim Preserve oldNamesArray(j)
oldNamesArray(j) = CStr(oldNameToBeConverted)
j = j + 1
Next oldNameToBeConverted
For Each oldName In oldNamesArray
currentOldName = Trim(CStr(oldName))
Sheets("Game Logs").Select
ActiveWorkbook.Worksheets("Game Logs").range("E1:G1").Value = Array(player, owner, currentOldName)
Call gl_find_rename_deck
Call RenameInSpecialCells(currentOldName, currentName)
Next oldName
End If
Next
Call gl_find_rename_deck_reset
' ENABLE EXCEL ANIMATIONS
Application.ScreenUpdating = True
End Sub
Sub RenameInSpecialCells(oldName As String, currentName As String)
For Each cell In ActiveWorkbook.Worksheets("Game Logs").AutoFilter.range.SpecialCells(xlCellTypeVisible)
If (StrComp(cell, oldName) = 0) Then
Dim rownumber As Integer
rownumber = cell.row
cell = currentName
Debug.Print ("Renamed " & oldName & " to " & currentName)
End If
Next cell
End Sub
Edit to add after feedback:
Sub RenameInSpecialCells(oldName As String, currentName As String)
dim rng as range, c as range
set rng = ActiveWorkbook.Worksheets("Game Logs").AutoFilter.range.SpecialCells(xlCellTypeVisible) #.range? can't get intellisense to trigger on this one#
For Each c In rng.cells
If (StrComp(c.value, oldName) = 0) Then
c.value = currentName
Debug.Print ("Renamed " & oldName & " to " & currentName)
End If
Next
End Sub
First post here, and new at coding, but I think I see some issues and hopefully can help.
Dim oldNameS As String
Note the s, plural.
You then use:
For Each oldName In oldNamesArray
Now you are calling oldName (singular) as if it was a member of an oldNames collection, but it is not.
You could go with:
For Each oldNames in oldNamesArray
The second problem I think is that you are trying to use a for each loop on a string array. To do that, your array needs to be a variant.
So your array declaration should read:
Dim oldNamesArray() as Variant
Lastly:
Dim name As Variant
I don't see this one getting used, maybe lost in the process?
With those comments the code looks like this:
Sub CleanOldDeckNames()
' DISABLE EXCEL ANIMATIONS
Application.ScreenUpdating = False
Dim player As String
Dim owner As String
Dim oldName As String
Dim oldNamesArray() As Variant
Dim currentName As String
Dim currentOldName As String
Sheets("Decklist").Select
Call dl_search_deck_hidden_reset
For i = 12 To 50
player = ActiveWorkbook.Worksheets("Decklist").range("A" & i).Value
owner = ActiveWorkbook.Worksheets("Decklist").range("B" & i).Value
currentName = ActiveWorkbook.Worksheets("Decklist").range("C" & i).Value
oldName = ActiveWorkbook.Worksheets("Decklist").range("D" & i).Value
oldNamesArray = Split(oldName, ",")
next
For Each oldName In oldNamesArray
currentOldName = Trim(CStr(oldName)) #not sure if CStr required#
Sheets("Game Logs").Select
ActiveWorkbook.Worksheets("Game Logs").range("E1:G1").Value = Array(player, owner, currentOldName)
Call gl_find_rename_deck
Call RenameInSpecialCells(currentOldName, currentName)
Next
Call gl_find_rename_deck_reset
' ENABLE EXCEL ANIMATIONS
Application.ScreenUpdating = True
End Sub
Sub RenameInSpecialCells(oldName As String, currentName As String)
For Each cell In ActiveWorkbook.Worksheets("Game Logs").AutoFilter.range.SpecialCells(xlCellTypeVisible)
If (StrComp(cell, oldName) = 0) Then
cell = currentName
Debug.Print ("Renamed " & oldName & " to " & currentName)
End If
Next cell
End Sub
Apologies if I'm way off the mark.
Edit to add: Your for each in array loop doesn't use i, so you can run the for i loop and for each loop in sequence rather than nesting them. Code amended accordingly.
I finally managed to circumvent the saving. I could not find any reason for why I could not edit the cell via SpecialCells, so I grabbed the row number and column number and edited it directly in the sheet. Turned out that worked.
I also did not need to use Variant as suggested, this simply works.
Sub CleanOldDeckNames()
' DISABLE EXCEL ANIMATIONS
Application.ScreenUpdating = False
Dim player As String
Dim owner As String
Dim oldNames As String
Dim oldNamesArray() As String
Dim currentName As String
Dim currentOldName As String
Dim j As Integer
Sheets("Decklist").Select
Call dl_search_deck_hidden_reset
For i = 12 To 50
player = ActiveWorkbook.Worksheets("Decklist").range("A" & i).Value
owner = ActiveWorkbook.Worksheets("Decklist").range("B" & i).Value
currentName = ActiveWorkbook.Worksheets("Decklist").range("C" & i).Value
oldNames = ActiveWorkbook.Worksheets("Decklist").range("D" & i).Value
oldNamesArray = Split(oldNames, ",")
Dim name As Variant
For Each oldName In oldNamesArray
currentOldName = Trim(oldName)
Sheets("Game Logs").Select
ActiveWorkbook.Worksheets("Game Logs").range("E1:G1").Value = Array(player, owner, currentOldName)
Call gl_find_rename_deck
Call RenameInSpecialCells(currentOldName, currentName)
Next oldName
Next i
Call gl_find_rename_deck_reset
' ENABLE EXCEL ANIMATIONS
Application.ScreenUpdating = True
End Sub
Sub RenameInSpecialCells(oldName As String, currentName As String)
For Each cell In ActiveWorkbook.Worksheets("Game Logs").AutoFilter.range.SpecialCells(xlCellTypeVisible)
If (StrComp(cell, oldName) = 0) Then
Debug.Print ("Attemtping to rename: " & cell)
ActiveWorkbook.Worksheets("Game Logs").Cells(cell.row, cell.Column).Value = "Chulane"
Debug.Print ("New content: " & ActiveWorkbook.Worksheets("Game Logs").Cells(cell.row, cell.Column))
End If
Next cell
End Sub
I am trying to set up an array in Access VBA. I have 40 different parameters to set and setting them using:
'ParameterName1.Visible = True...
'ParameterName2.Visible = True...
is rather clunky. I believe it can be done with an array such as:
'for i = 1 to 40
' ParameterName(i).Visible = True
'Next i
I am a novice in Access vba. I have done some simple coding but this is my first attempt at arrays
Private Sub Form_Load()
Dim NewPN As Boolean
Dim i As Integer
Dim ParameterName(1 To 10) As Variant
Dim ParameterNominal(1 To 10) As Variant
Dim ParameterMinimum(1 To 10) As Variant
Dim ParameterMaximum(1 To 10) As Variant
NewPN = MsgBox("Is This A New Part Number?", vbYesNo, "New Part Number")
If NewPN = True Then
For i = 1 To 10
ParameterName(i).Visible = False
ParameterNominal(i).Visible = False
ParameterMinimum(i).Visible = False
ParameterMaximum(i).Visible = False
Next i
ParaQty = InputBox("How many parameters will be measured?", Parameters?")
For i = 1 To ParaQty
ParameterName(i) = InputBox("Please Enter the Name for Parameter
(Include Units, if applicable) " & i, "Parameter Name?")
ParameterNominal(i) = InputBox("Please Enter the Nominal Value
for Parameter " & i, "Nominal Parameter?")
ParameterMinimum(i) = InputBox("Please Enter the Minimun Value for
Parameter " & i, "Minimum Parameter?")
ParameterMaximum(i) = InputBox("Please Enter the Maximum Value for
Parameter " & i, "Maximum Parameter?")
Next i
End If
End Sub
I get a "object required" error message on the first pass of the for/next loop.
I have wrote some VBA code which I was fairly happy with. It went through a list on a worksheet, switched to another and set a variable (and thus changed some graphs) and then opened word, copied in the graphs to various bookmarks and saved the document as the variable name.
It worked like a charm and I was a happy boy (saved a good week and a bit of work for someone). I have not touched it since - or the worksheets for that matter - opened it today and it is giving me a type missmatch on the first lot. I would really love some advice as it has left me scratching my head.
Public X As Integer
Public Y As String
Sub Macro2()
'Set up variables that are required
Y = ""
LoopCounter = 2
Do Until Y = "STOP"
'Grab the value from a list
Sheets("CPD data 13-14").Select
Range("A" & LoopCounter).Select
Y = Range("A" & LoopCounter).Value
'Change the chart values
Sheets("Pretty Display (2)").Select
Range("A1").Value = Y
'Open word template
Set wordapp = CreateObject("word.Application")
wordapp.documents.Open "LOCATION"
wordapp.Visible = True
wordapp.Activate
wordapp.ActiveDocument.Bookmarks("InstitutionName").Range = Y
wordapp.ActiveDocument.Bookmarks("Graph1").Range = ActiveSheet.ChartObjects("Chart 3")
'Close document
Mystring = Replace(Y, " ", "")
wordapp.ActiveDocument.SaveAs Filename:="LOCATION" & Mystring & ".docx"
wordapp.Quit
Set wordapp = Nothing
'Increase count and loop
LoopCounter = LoopCounter + 1
Loop
The error hits on the following line:
wordapp.ActiveDocument.Bookmarks("Graph1").Range = ActiveSheet.ChartObjects("Chart 3")
EDIT
As suggested I have updated my code not to use select so it now reads:
Set ws = Sheets("CPD data 13-14")
Set pd = Sheets("Pretty Display (2)")
'Set up variables that are required
Y = ""
LoopCounter = 2
Do Until Y = "STOP"
'Grab the value from a list
Y = ws.Range("A" & LoopCounter).Value
'Change the chart values
pd.Range("A1").Value = Y
'Open word template
Set wordapp = CreateObject("word.Application")
wordapp.documents.Open "LOCATION"
wordapp.Visible = True
wordapp.Activate
wordapp.ActiveDocument.Bookmarks("InstitutionName").Range = Y
wordapp.ActiveDocument.Bookmarks("Graph1").Range = pd.ChartObjects("Chart 3")
'Close document
Mystring = Replace(Y, " ", "")
wordapp.ActiveDocument.SaveAs Filename:="LOCATION" & Mystring & ".docx"
wordapp.Quit
Set wordapp = Nothing
'Increase count and loop
LoopCounter = LoopCounter + 1
Loop
I still get the same runtime error at the same point.
try this
Option Explicit
Public X As Integer
Public Y As String
Sub Macro2()
Dim wordApp As Object
Dim LoopCounter As Integer
Dim Mystring As String
Dim ws As Worksheet, pd As Worksheet
Set ws = Sheets("CPD data 13-14")
Set pd = Sheets("Pretty Display (2)")
'Set up variables that are required
Y = ""
LoopCounter = 2
' open one Word session for all the documents to be processed
Set wordApp = CreateObject("word.Application")
Do Until Y = "STOP"
'Grab the value from a list
Y = ws.Range("A" & LoopCounter).Value
With pd
.Range("A1").Value = Y 'Change the chart values
.ChartObjects("Chart 3").Copy ' Copy the chart
End With
'act on Word application
With wordApp
'open word template
.documents.Open "LOCATION"
.Visible = True
' paste into bookmarks, "save as" document and close it
With .ActiveDocument
.Bookmarks("InstitutionName").Range = Y
.Bookmarks("Graph1").Range.PasteSpecial
Mystring = Replace(Y, " ", "")
.SaveAs Filename:="LOCATION" & Mystring & ".docx"
.Close
End With
End With
'Increase count and loop
LoopCounter = LoopCounter + 1
Loop
'Close Word
wordApp.Quit
Set wordApp = Nothing
End Sub
I couldn't have a word "Range" object directly set to an Excel "Chart" object
So I had to copy the chart and use "PasteSpecial" method of the Word "Range" object
Furthemore I worked with one Word session only, which'd result in a faster job
Finally I also made some "comsetics" to make the code more readable/maintanable
just as a suggestion: I'd always use "Option Explicit" statement. that'll force you some extra work to explicitly declare each and every variable you use, but that will also give much more control over your work and result in less debbugging issues, thus saving time at the end
My advice is to set the Explicit flag and try to decompile the code. Any variables that you didn't dimension will throw an error. This is a good time to dimension the variable and type the data appropriately.
If that doens't throw an error, which it should since you have at least one variable LoopCounter that isn't dimensioned and could therefore cause data type errors then try changing Public X As Integer to Public X As Long so as to avoid values beyond the limit of the Integer data type.
.Activate is sometimes necessary even when using .Select from my experience. Selecting a worksheet should make it the active worksheet, but that's not always the case.
I am writing a VBA program that will allow me to mine through a set of Excel data and pull out relevant information which is then copied to another sheet.
I keep trying to make it so that the word that is being searched for is highlighted in yellow, however my program constantly throws "Compile error - expected array on Ubound".
Option Compare Text
Public Sub Textchecker()
'
' Textchecker
'
' Keyboard Shortcut: Ctrl+h
'
Dim Continue As Long
Dim findWhat As String
Dim LastLine As Long
Dim toCopy As Boolean
Dim cell As Range
Dim item As Long
Dim j As Long
Dim sheetIndex As Long
Dim inclusion As String
sheetIndex = 2
Continue = vbYes
Do While Continue = vbYes
findWhat = CStr(InputBox("What word would you like to search for today?"))
inclusion = CStr(InputBox("Do you have any inclusions? Separate words with commas"))
LastLine = ActiveSheet.UsedRange.Rows.Count
If findWhat = "" Then Exit Sub
j = 1
For item = 1 To LastLine
If UBound(inclusion) >= 0 Then
For Each cell In Range("BY1").Offset(item - 1, 0) Then
For Each item In inclusion
If InStr(cell.Text, findWhat) <> 0 And InStr(cell.Text, inclusion) <> 0 Then
findWhat.Interior.Color = 6
toCopy = True
Else
For Each cell In Range("BY1").Offset(item - 1, 0) Then
If InStr(cell.Text, findWhat) <> 0 Then
findWhat.Interior.Color = 6
toCopy = True
End If
Next item
End If
Next
If toCopy = True Then
Sheets(sheetIndex).Name = UCase(findWhat) + "+" + LCase(inclusion)
Rows(item).Copy Destination:=Sheets(sheetIndex).Rows(j)
j = j + 1
End If
toCopy = False
Next item
sheetIndex = sheetIndex + 1
Continue = MsgBox(((j - 1) & " results were copied, do you have more keywords to enter?"), vbYesNo + vbQuestion)
Loop
End Sub
What am I doing wrong here?
In your code, inclusion is declared as a String variable, and contains a String, albeit a String separated by commas. The Ubound function works on arrays.
To fix: Convert the string into an array using the Split function. See the below example for some quick help, and let us know if you need more details.
Sub Tests()
Dim inclusion() As String
inclusion = Split("One, Two, Three", ",")
MsgBox (UBound(inclusion))
End Sub
To answer your last comment.
A variable in For Each must be of type Object or Variant.
To change your 'item' in a Variant, replace 'Dim item As Long' by 'Dim item As Variant', or even by 'Dim item' as a variable declared without a type is a Variant.