MS Word 2016 (Office365) question

zombiemaster

Board Regular
Joined
Oct 27, 2009
Messages
241
I have a Word macro that used to work in Office2007 but we just upgraded to O365 (Office2016) and now it's getting stuck.

I have two Word documents that get color-coded then combined into one Word file and saved to our LAN. The two word docs are named "ID-SUSP-DI" and "ID-SUSP-ZJ" each week and then I run the macro to color/combine them, and it saves the final version into "ID-SUSP-DIZJ".

The code includes this piece that activates the DI version:

'Windows("ID-SUSP-DI").Activate'

And later, after formatting the DI file:

'Windows("ID-SUSP-ZJ").Activate'

To format the ZJ file and copy/paste it into the bottom of the DI version.

Those 'jumping back and forth' pieces no longer work - apparently the new version of Word doesn't allow jumping back and forth between multiple files...

I can run the code and manually switch between the two open Word docs each time the runtime error debugger pops up, and that's what I had to do today to finish the report...but would LOVE IT if someone here knew how to write the code to jump between the two files like we used to be able to do???

Thanks in advance for anybody's help...

~ZM~
 
Your code mostly looks like it's been created using the macro recorder, which explains the unnecessary window switching. It's also unnecessarily verbose. Try the following. There's a few things like repeated instances of:
Selection.Delete Unit:=wdCharacter, Count:=1
and
Selection.Find.Execute Replace:=wdReplaceAll
I don't understand the need for, so the code may not yet do all that you require of it.
Code:
Sub WeeklySuspense()
Application.ScreenUpdating = False
Dim i As Long, j As Long, k As Long, bDI As Boolean, bZJ As Boolean
bDI = False: bZJ = False
'Loop thru all open docs to find our two
For i = 1 To Documents.Count
  Select Case Split(Documents(i).Name, "doc")(0)
    'Prepare ID-SUSP-DI
    Case "ID-SUSP-DI"
      bDI = True: j = i
      With Documents(i).Range
        With .Find
          .ClearFormatting
          .Text = "AGED SUSPENSE RANGE TOTALS"
          .Replacement.Text = ""
          .Forward = True
          .Wrap = wdFindContinue
          .Format = False
          .MatchCase = False
          .MatchWholeWord = False
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
          .Execute
        End With
        If .Find.Found Then
          .Start = .Paragraphs.First.Start
          .End = Documents(i).Range.End
          .Text = Chr(12)
          Documents(i).Range.Font.Color = wdColorBlue
        End If
      End With
    'Prepare ID-SUSP-ZJ
    Case "ID-SUSP-ZJ"
      bZJ = True: k = i
      With Documents(i).Range
        With .Find
          .ClearFormatting
          .Text = "AGED SUSPENSE RANGE TOTALS"
          .Replacement.Text = ""
          .Forward = True
          .Wrap = wdFindContinue
          .Format = False
          .MatchCase = False
          .MatchWholeWord = False
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
          .Execute
        End With
        If .Find.Found Then
          .Start = .Paragraphs.First.Start
          .End = Documents(i).Range.End
          .Text = vbNullString
          Documents(i).Range.Font.Color = wdColorRed
        End If
      End With
    Case Else
  End Select
  'If both found, combine ID-SUSP-DI & ID-SUSP-ZJ
  If (bDI = True) And (bZJ = True) Then
    With Documents(j).Range
      .Characters.Last.FormattedText = Documents(k).Range.FormattedText
      'Close the ZJ document
      Documents(k).Close SaveChanges:=False
      'Reformat the DI document
      With .Find
        .ClearFormatting
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchWildcards = True
        .Replacement.Text = ""
        .Text = "0[=]{108}"
        .Execute Replace:=wdReplaceAll
        .Text = "[=]{108}"
        .Execute Replace:=wdReplaceAll
        .Text = " DI80440B[ ]@AGED SUSPENSE REPORT[ ]@PAGE: [0-9]{3}"
        .Execute Replace:=wdReplaceAll
        .Text = "^13[ ]@[0-9]{2}/[0-9]{2}/20[0-9]{2}"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]@CUSTOMAX (DIRECT)"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]@CUSTOMAX (JV)"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]@FUNCTION:[ ]{1,}"
        .Replacement.Text = " FUNCTION:^t"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]@FUNCTION:"
        .Execute Replace:=wdReplaceAll
        .Text = "-SERV OFFICE[ ]@0-29[ ]@30-60[ ]@61-90[ ]@91-120[ ]@121-150[ ]@151-180[ ]@180+[ ]@TOTAL"
        .Replacement.Text = "-SO^t0-29^t30-60^t61-90^t91-120^t121-150^t151-180^t180+^tTOTAL"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]{2,}"
        .Replacement.Text = "^t"
        .Execute Replace:=wdReplaceAll
        .Text = "^t[=]{2,}"
        .Execute Replace:=wdReplaceAll
        .Text = "[=]{1,}"
        .Replacement.Text = ""
        .Execute Replace:=wdReplaceAll
        .Text = "^t^13"
        .Replacement.Text = "^p"
        .Execute Replace:=wdReplaceAll
        .Text = "[^t]{2,}"
        .Replacement.Text = "^t"
        .Execute Replace:=wdReplaceAll
        .Text = "^13[0-1]^13"
        .Replacement.Text = "^p^p"
        .Execute Replace:=wdReplaceAll
      End With
      .ParagraphFormat.TabStops.ClearAll
      .DefaultTabStop = InchesToPoints(1.1)
      With .PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientLandscape
        .TopMargin = InchesToPoints(0.5)
        .BottomMargin = InchesToPoints(0.5)
        .LeftMargin = InchesToPoints(0.5)
        .RightMargin = InchesToPoints(0.5)
        .Gutter = InchesToPoints(0)
        .HeaderDistance = InchesToPoints(0.3)
        .FooterDistance = InchesToPoints(0.3)
        .PageWidth = InchesToPoints(14)
        .PageHeight = InchesToPoints(8.5)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
      End With
      'Save the DI document as a new file.
      .SaveAs FileName:="C:\_MIS FILES\ID-SUSP-DIZJ COMBINED.docx", _
        FileFormat:=wdFormatXMLDocument, LockComments:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, _
        ReadOnlyRecommended:=False, AddToRecentFiles:=True, _
        EmbedTrueTypeFonts:=False, SaveAsAOCELetter:=False, _
        WritePassword:="", Password:=""
      'Close the DI document.
      '.Close SaveChanges:=False
    End With
    Exit For
  End If
Next
If (bDI = False) And (bZJ = False) Then
  MsgBox "ID-SUSP-DI and ID-SUSP-ZJ not found", vbExclamation
ElseIf bDI = False Then
  Documents("ID-SUSP-ZJ").Close SaveChanges:=False
  MsgBox "ID-SUSP-DI not found", vbExclamation
ElseIf bZJ = False Then
  Documents("ID-SUSP-DI").Close SaveChanges:=False
  MsgBox "ID-SUSP-ZJ not found", vbExclamation
End If
Application.ScreenUpdating = True
End Sub
As coded, the macro leaves the output document open, but you'll see the commented-out line for closing it.

Thanks for looking at it, Paul. The repeated instances are there because of a varying number of spaces that appear in the original data - we need to delete all repeated instances of blank spaces, that's why you will see the diminishing number of spaces changed to tabs. If what you've proposed above does the same thing by using those codes I'm not familiar with, this will be a lot shorter. :)

I'll check it out this week and see if it works as I need it to - thanks for your help!

:cool:
~ZM~
 
Upvote 0

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Hi, Paul...

I was finally able to try your code this morning, but ran into an error: "Compile error: Method of data member not found". When I debug, it highlights the ".Start" section below:

Rich (BB code):
Sub WeeklySuspense_FROM_MR_EXCEL()
Application.ScreenUpdating = False
Dim i As Long, j As Long, k As Long, bDI As Boolean, bZJ As Boolean
bDI = False: bZJ = False
'Loop thru all open docs to find our two
For i = 1 To Documents.Count
  Select Case Split(Documents(i).Name, "doc")(0)
    'Prepare ID-SUSP-DI
    Case "ID-SUSP-DI"
      bDI = True: j = i
      With Documents(i).Range
        With .Find
          .ClearFormatting
          .Text = "AGED SUSPENSE RANGE TOTALS"
          .Replacement.Text = ""
          .Forward = True
          .Wrap = wdFindContinue
          .Format = False
          .MatchCase = False
          .MatchWholeWord = False
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
          .Execute
        End With
        If .Find.Found Then
          .Start = .Paragraphs.First.Start
          .End = Documents(i).Range.End
          .Text = Chr(12)
          Documents(i).Range.Font.Color = wdColorBlue
        End If
      End With
    'Prepare ID-SUSP-ZJ
    Case "ID-SUSP-ZJ"
      bZJ = True: k = i
      With Documents(i).Range
        With .Find
          .ClearFormatting
          .Text = "AGED SUSPENSE RANGE TOTALS"
          .Replacement.Text = ""
          .Forward = True
          .Wrap = wdFindContinue
          .Format = False
          .MatchCase = False
          .MatchWholeWord = False
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
          .Execute
        End With
        If .Find.Found Then
          .Start = .Paragraphs.First.Start
          .End = Documents(i).Range.End
          .Text = vbNullString
          Documents(i).Range.Font.Color = wdColorRed
        End If
      End With
    Case Else
  End Select
  'If both found, combine ID-SUSP-DI & ID-SUSP-ZJ
  If (bDI = True) And (bZJ = True) Then
    With Documents(j).Range
      .Characters.Last.FormattedText = Documents(k).Range.FormattedText
      'Close the ZJ document
      Documents(k).Close SaveChanges:=False
      'Reformat the DI document
      With .Find
        .ClearFormatting
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchWildcards = True
        .Replacement.Text = ""
        .Text = "0[=]{108}"
        .Execute Replace:=wdReplaceAll
        .Text = "[=]{108}"
        .Execute Replace:=wdReplaceAll
        .Text = " DI80440B[ ]@AGED SUSPENSE REPORT[ ]@PAGE: [0-9]{3}"
        .Execute Replace:=wdReplaceAll
        .Text = "^13[ ]@[0-9]{2}/[0-9]{2}/20[0-9]{2}"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]@CUSTOMAX (DIRECT)"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]@CUSTOMAX (JV)"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]@FUNCTION:[ ]{1,}"
        .Replacement.Text = " FUNCTION:^t"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]@FUNCTION:"
        .Execute Replace:=wdReplaceAll
        .Text = "-SERV OFFICE[ ]@0-29[ ]@30-60[ ]@61-90[ ]@91-120[ ]@121-150[ ]@151-180[ ]@180+[ ]@TOTAL"
        .Replacement.Text = "-SO^t0-29^t30-60^t61-90^t91-120^t121-150^t151-180^t180+^tTOTAL"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]{2,}"
        .Replacement.Text = "^t"
        .Execute Replace:=wdReplaceAll
        .Text = "^t[=]{2,}"
        .Execute Replace:=wdReplaceAll
        .Text = "[=]{1,}"
        .Replacement.Text = ""
        .Execute Replace:=wdReplaceAll
        .Text = "^t^13"
        .Replacement.Text = "^p"
        .Execute Replace:=wdReplaceAll
        .Text = "[^t]{2,}"
        .Replacement.Text = "^t"
        .Execute Replace:=wdReplaceAll
        .Text = "^13[0-1]^13"
        .Replacement.Text = "^p^p"
        .Execute Replace:=wdReplaceAll
      End With
      .ParagraphFormat.TabStops.ClearAll
      .DefaultTabStop = InchesToPoints(1.1)
      With .PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientLandscape
        .TopMargin = InchesToPoints(0.5)
        .BottomMargin = InchesToPoints(0.5)
        .LeftMargin = InchesToPoints(0.5)
        .RightMargin = InchesToPoints(0.5)
        .Gutter = InchesToPoints(0)
        .HeaderDistance = InchesToPoints(0.3)
        .FooterDistance = InchesToPoints(0.3)
        .PageWidth = InchesToPoints(14)
        .PageHeight = InchesToPoints(8.5)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
      End With
      'Save the DI document as a new file.
      .SaveAs FileName:="C:\_MIS FILES\ID-SUSP-DIZJ COMBINED.docx", _
        FileFormat:=wdFormatXMLDocument, LockComments:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, _
        ReadOnlyRecommended:=False, AddToRecentFiles:=True, _
        EmbedTrueTypeFonts:=False, SaveAsAOCELetter:=False, _
        WritePassword:="", Password:=""
      'Close the DI document.
      '.Close SaveChanges:=False
    End With
    Exit For
  End If
Next
If (bDI = False) And (bZJ = False) Then
  MsgBox "ID-SUSP-DI and ID-SUSP-ZJ not found", vbExclamation
ElseIf bDI = False Then
  Documents("ID-SUSP-ZJ").Close SaveChanges:=False
  MsgBox "ID-SUSP-DI not found", vbExclamation
ElseIf bZJ = False Then
  Documents("ID-SUSP-DI").Close SaveChanges:=False
  MsgBox "ID-SUSP-ZJ not found", vbExclamation
End If
Application.ScreenUpdating = True
End Sub
 
Upvote 0
I just found a workaround! As you know, I have two documents: a "DI" version and a "ZJ" version. I was opening them BOTH and running the code, and having problems. I just opened the DI file, then navigated to File > Open and opened the ZJ version that way. When I ran my original code, it worked fine! So from now on I just can't open them in separate instances of Word, and I think I'm golden...

Thanks for your help, I appreciate it very much!

~ZM~
:cool:
 
Upvote 0
Hi, Paul...

I was finally able to try your code this morning, but ran into an error: "Compile error: Method of data member not found".
Oops - instead of:
.Start = .Paragraphs.First.Start
use:
.Start = .Paragraphs.First.Range.Start
 
Upvote 0
Oops - instead of:
.Start = .Paragraphs.First.Start
use:
.Start = .Paragraphs.First.Range.Start

Hi, Paul...still running into a few errors along the way, but the main problem is that it still didn't recognize the separate files so it didn't actually do any of the formatting. When I ran it (after commenting out the items shown below to allow it to run through the entire thing), it just gave me the "ID and ZJ Not Found" message that you added at the bottom.

Code:
Sub WeeklySuspense_FROM_MR_EXCEL()
Application.ScreenUpdating = False
Dim i As Long, j As Long, k As Long, bDI As Boolean, bZJ As Boolean
bDI = False: bZJ = False
'Loop thru all open docs to find our two
For i = 1 To Documents.Count
  Select Case Split(Documents(i).Name, "doc")(0)
    'Prepare ID-SUSP-DI
    Case "ID-SUSP-DI"
      bDI = True: j = i
      With Documents(i).Range
        With .Find
          .ClearFormatting
          .Text = "AGED SUSPENSE RANGE TOTALS"
          .Replacement.Text = ""
          .Forward = True
          .Wrap = wdFindContinue
          .Format = False
          .MatchCase = False
          .MatchWholeWord = False
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
          .Execute
        End With
        If .Find.Found Then
          .Start = .Paragraphs.First.Range.Start
          .End = Documents(i).Range.End
          .Text = Chr(12)
          Documents(i).Range.Font.Color = wdColorBlue
        End If
      End With
    'Prepare ID-SUSP-ZJ
    Case "ID-SUSP-ZJ"
      bZJ = True: k = i
      With Documents(i).Range
        With .Find
          .ClearFormatting
          .Text = "AGED SUSPENSE RANGE TOTALS"
          .Replacement.Text = ""
          .Forward = True
          .Wrap = wdFindContinue
          .Format = False
          .MatchCase = False
          .MatchWholeWord = False
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
          .Execute
        End With
        If .Find.Found Then
          .Start = .Paragraphs.First.Range.Start
          .End = Documents(i).Range.End
          .Text = vbNullString
          Documents(i).Range.Font.Color = wdColorRed
        End If
      End With
    Case Else
  End Select
  'If both found, combine ID-SUSP-DI & ID-SUSP-ZJ
  If (bDI = True) And (bZJ = True) Then
    With Documents(j).Range
      .Characters.Last.FormattedText = Documents(k).Range.FormattedText
      'Close the ZJ document
      Documents(k).Close SaveChanges:=False
      'Reformat the DI document
      With .Find
        .ClearFormatting
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchWildcards = True
        .Replacement.Text = ""
        .Text = "0[=]{108}"
        .Execute Replace:=wdReplaceAll
        .Text = "[=]{108}"
        .Execute Replace:=wdReplaceAll
        .Text = " DI80440B[ ]@AGED SUSPENSE REPORT[ ]@PAGE: [0-9]{3}"
        .Execute Replace:=wdReplaceAll
        .Text = "^13[ ]@[0-9]{2}/[0-9]{2}/20[0-9]{2}"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]@CUSTOMAX (DIRECT)"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]@CUSTOMAX (JV)"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]@FUNCTION:[ ]{1,}"
        .Replacement.Text = " FUNCTION:^t"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]@FUNCTION:"
        .Execute Replace:=wdReplaceAll
        .Text = "-SERV OFFICE[ ]@0-29[ ]@30-60[ ]@61-90[ ]@91-120[ ]@121-150[ ]@151-180[ ]@180+[ ]@TOTAL"
        .Replacement.Text = "-SO^t0-29^t30-60^t61-90^t91-120^t121-150^t151-180^t180+^tTOTAL"
        .Execute Replace:=wdReplaceAll
        .Text = "[ ]{2,}"
        .Replacement.Text = "^t"
        .Execute Replace:=wdReplaceAll
        .Text = "^t[=]{2,}"
        .Execute Replace:=wdReplaceAll
        .Text = "[=]{1,}"
        .Replacement.Text = ""
        .Execute Replace:=wdReplaceAll
        .Text = "^t^13"
        .Replacement.Text = "^p"
        .Execute Replace:=wdReplaceAll
        .Text = "[^t]{2,}"
        .Replacement.Text = "^t"
        .Execute Replace:=wdReplaceAll
        .Text = "^13[0-1]^13"
        .Replacement.Text = "^p^p"
        .Execute Replace:=wdReplaceAll
      End With
      .ParagraphFormat.TabStops.ClearAll
[B][COLOR="#FF0000"]'      .DefaultTabStop = InchesToPoints(1.1)[/COLOR][/B]
      With .PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientLandscape
        .TopMargin = InchesToPoints(0.5)
        .BottomMargin = InchesToPoints(0.5)
        .LeftMargin = InchesToPoints(0.5)
        .RightMargin = InchesToPoints(0.5)
        .Gutter = InchesToPoints(0)
        .HeaderDistance = InchesToPoints(0.3)
        .FooterDistance = InchesToPoints(0.3)
        .PageWidth = InchesToPoints(14)
        .PageHeight = InchesToPoints(8.5)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
      End With
      'Save the DI document as a new file.
[COLOR="#FF0000"][B]'      .SaveAs FileName:="C:\_MIS FILES\ID-SUSP-DIZJ COMBINED.docx", _[/B][/COLOR]
        FileFormat:=wdFormatXMLDocument, LockComments:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, _
        ReadOnlyRecommended:=False, AddToRecentFiles:=True, _
        EmbedTrueTypeFonts:=False, SaveAsAOCELetter:=False, _
        WritePassword:="", Password:=""
      'Close the DI document.
      '.Close SaveChanges:=False
    End With
    Exit For
  End If
Next
If (bDI = False) And (bZJ = False) Then
  MsgBox "ID-SUSP-DI and ID-SUSP-ZJ not found", vbExclamation
ElseIf bDI = False Then
  Documents("ID-SUSP-ZJ").Close SaveChanges:=False
  MsgBox "ID-SUSP-DI not found", vbExclamation
ElseIf bZJ = False Then
  Documents("ID-SUSP-DI").Close SaveChanges:=False
  MsgBox "ID-SUSP-ZJ not found", vbExclamation
End If
Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,215,065
Messages
6,122,945
Members
449,095
Latest member
nmaske

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top