Find and Replace Long List

[Rishek]

I continue to hack away at automating scheduling:

I often write things on a schedule like "Group A" Group A contains twenty eight names and attempting to use:


Sub ListExpand()
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "Group A"
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
Set oRng = ActiveDocument.Range

.Replacement.Text = "List of many many many many many many many names like just a ton, way over 255 characters which seems to be the absolute maximum string length, am I there yet? I don't know, I'll just keep going but maybe you get my point?"
End With
End Sub

Results in a a "string too long" error.

[gmaxey]

That is because the many VBA properties have a 255 character string limit. Copy your long string to the clipboard and use:


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "Group A"
.Replacement.Text = "^c"
.Execute Replace:=wdReplaceAll
End With
lbl_Exit:
Exit Sub

End Sub

[Rishek]

This is what I thought. Unfortunately, I have about eight different Groups I was hoping to slot and out, so this isn't really much more efficient than simply copying and pasting manually. My thought was to create an excel file and have the the macro call on it.

It'd have the form:



Group Name
List of names


Group A
Names of People in Group A


Group B
Names of People in Group B


Group C
Names of People in Group C


Group D
Names of People in Group D



Is that possible?

[gmaxey]

Yes it is. Or you could use a Word table.

[Rishek]

So I'm trying to modify what I found in:

https://www.thespreadsheetguru.com/the-code-vault/2014/4/14/find-and-replace-all?rq=Multiple%20Iterations

and

http://www.vbaexpress.com/forum/showthread.php?59045-Multiple-Find-Replace-At-Once-(Feeding-From-A-Table)&highlight=find+replace


Sub ReplaceFromList()
Dim sht As Worksheet
Dim fndList As Variant
Dim x As Long
Dim Source As Workbook
Dim Target As ActiveDocument


Set Source = Workbooks.Open("/Users/wfrobertson/Desktop/ReplacementLists.xlsx")


fndList = Source.Sheets(1).Range("A:B").SpecialCells(2).Value
Source.Close False


'Loop through each item in Array lists
For x = LBound(fndList) To UBound(fndList)
'Loop through each worksheet in ActiveWorkbook
For Each sht In Target.ActiveDocument
sht.Cells.Replace What:=fndList(x, 1), Replacement:=fndList(x, 2), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
Next x
End Sub

I feel somewhat like a monkey with a flame thrower. I'm finding and replacing in word but drawing on an excel table.

[mdmackillop]

You could use Autotext entries


Const TP = "C:\Users\Emachine\AppData\Roaming\Microsoft\Templates\Normal.dotm"

Sub ListExpand()
Dim oRng As Range
Dim Group As String

Group = InputBox("Text to replace/AutoText name")

Set oRng = ActiveDocument.Range
With oRng.Find
.Text = Group
.MatchWildcards = False
.Execute
Application.Templates(TP).BuildingBlockEntries(Group).Insert Where:=oRng, RichText:=True
End With
End Sub