Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 03-17-2022, 04:04 PM
Venteux Venteux is offline Macro to compare paragraph count between two documents Windows 10 Macro to compare paragraph count between two documents Office 2019
Novice
Macro to compare paragraph count between two documents
 
Join Date: May 2021
Posts: 22
Venteux is on a distinguished road
Default Macro to compare paragraph count between two documents

Hi, I'm looking for a macro that will compare two different word documents and let me know if there's a difference in the number of paragraphs.



For example, we usually have one document in English, and one translated to French. Sometimes when the English gets translated, the translator may skip a section by accident, or they may have combined two paragraphs by accident. We have 250+ documents to go through every year. Currently, we do it manually by having both documents open side by side and look to see that all of the paragraphs in the French correspond to the English.

Is this something that can be done through a macro?

Any help is appreciated!
Reply With Quote
  #2  
Old 03-18-2022, 12:31 AM
Peterson Peterson is offline Macro to compare paragraph count between two documents Windows 10 Macro to compare paragraph count between two documents Office 2019
Competent Performer
 
Join Date: Jan 2017
Posts: 143
Peterson is on a distinguished road
Default

Try the code below, which does the following:
  1. Prompts you to choose a folder with the English versions
  2. Prompts you to choose a folder with the French versions
  3. Gets the file name and number of paragraphs for all files in English and French
  4. Compares the paragraph totals
  5. If a pair of files doesn't have the same number of paragraphs, then in the Immediate window, a message says as much, showing the file names of both versions. (Show the Immediate window via View > Immediate Window, or Ctrl+G.)
Assumptions
  • The English and French folders contain exactly the same set of files, just in their respective languages.
  • Both sets of files are in EXACTLY THE SAME ORDER in both folders.
Code:
Option Explicit

Sub CompareEnglishAndFrenchFiles() ' 03/18/2022
    
    Dim strFolderEnglish As String          ' User-input location of English files
    Dim strFolderFrench As String           ' User-input location of French files
    Dim strNumParasEnglish As String        ' String of English file names and paragraph numbers, concatenated; to be split into an array
    Dim strArrayEnglishParas() As String    ' Array for number of paragraphs in English files
    Dim strNumParasFrench As String         ' String of French file names and paragraph numbers, concatenated; to be split into an array
    Dim strArrayFrenchParas() As String     ' Array for number of paragraphs in French files
    Dim i As Long                           ' For comparing English and French versions
    
    ' Get location of English files:
    MsgBox "Click OK, then choose the folder containing the English versions."
    strFolderEnglish = fcnGetFolderFromPicker(strFolderEnglish)
    
    ' Get location of French files:
    MsgBox "Click OK, then choose the folder containing the French versions."
    strFolderFrench = fcnGetFolderFromPicker(strFolderFrench)
        
    ' Loop through English files and get file name and paragraph totals:
    strNumParasEnglish = fcnGetNumParasInAllWordFilesInFolder(strFolderEnglish)
    
    ' Split string of English file names and paragraph totals and populate array:
    strArrayEnglishParas = Split(strNumParasEnglish, ",")
    
    ' Loop through French files and get file name and paragraph totals:
    strNumParasFrench = fcnGetNumParasInAllWordFilesInFolder(strFolderFrench)
    
    ' Split string of French file names and paragraph totals and populate array:
    strArrayFrenchParas = Split(strNumParasFrench, ",")
    
    ' Compare paragraph totals between pairs of files:
    For i = LBound(strArrayEnglishParas) To UBound(strArrayEnglishParas)
        ' If a pair of files has unequal paragraph totals:
        If Right(strArrayEnglishParas(i), Len(strArrayEnglishParas(i)) - InStr(strArrayEnglishParas(i), "|")) <> _
        Right(strArrayFrenchParas(i), Len(strArrayFrenchParas(i)) - InStr(strArrayFrenchParas(i), "|")) Then
            
            ' ...then print out info about pairs of files that don't have equal totals:
            Debug.Print "The following two documents don't have equal paragraph totals: " & vbCr
            Debug.Print "   " & Mid(strArrayEnglishParas(i), 1, InStr(strArrayEnglishParas(i), "|") - 1)
            Debug.Print "   " & Mid(strArrayFrenchParas(i), 1, InStr(strArrayFrenchParas(i), "|") - 1) & vbCr
        End If
    Next i
End Sub

Function fcnGetNumParasInAllWordFilesInFolder(myFolderPath As String) As String ' 03/18/2022

    Dim myDocument As Document
    Dim strPath As String
    Dim strFile As String
    Dim strExtension As String
    Dim strNumParagraphs As String
    
    Application.ScreenUpdating = False
    
    strPath = myFolderPath
    strExtension = "*.doc*"
    
    ' Target path with file extension:
    strFile = Dir(strPath & strExtension)

    ' Loop through each file in the folder:
    Do While strFile <> ""
        ' Set variable equal to opened document:
        Set myDocument = Documents.Open(FileName:=strPath & strFile)
                
        If strNumParagraphs = "" Then
            strNumParagraphs = strFile & "|" & myDocument.Range.Paragraphs.Count
        Else
            strNumParagraphs = strNumParagraphs & "," & strFile & "|" & myDocument.Range.Paragraphs.Count
        End If
                    
        myDocument.Close SaveChanges:=False

        ' Get next file name:
        strFile = Dir
    Loop
    
    fcnGetNumParasInAllWordFilesInFolder = strNumParagraphs
    
ResetSettings:
    Application.ScreenUpdating = True

End Function

Function fcnGetFolderFromPicker(myFolderPath As String) As String ' 03/18/2022

    Dim strPath As String
    Dim strFile As String
    Dim FolderPicker As FileDialog

    ' Get target folder path from user:
    Set FolderPicker = Application.FileDialog(msoFileDialogFolderPicker)
        With FolderPicker
            .Title = "Choose the folder containing your files"
            .AllowMultiSelect = False
                If .Show <> -1 Then GoTo NextCode
                strPath = .SelectedItems(1) & "\"
        End With

    fcnGetFolderFromPicker = strPath

NextCode: ' In case the user cancels
    strPath = strPath

End Function
Reply With Quote
  #3  
Old 03-18-2022, 08:55 AM
Venteux Venteux is offline Macro to compare paragraph count between two documents Windows 10 Macro to compare paragraph count between two documents Office 2019
Novice
Macro to compare paragraph count between two documents
 
Join Date: May 2021
Posts: 22
Venteux is on a distinguished road
Default

This works perfectly!! Thank you so much!
Reply With Quote
  #4  
Old 03-18-2022, 09:40 AM
Peterson Peterson is offline Macro to compare paragraph count between two documents Windows 10 Macro to compare paragraph count between two documents Office 2019
Competent Performer
 
Join Date: Jan 2017
Posts: 143
Peterson is on a distinguished road
Default

You're welcome.docx
Je vous en prie.docx


Reply With Quote
Reply



Similar Threads
Thread Thread Starter Forum Replies Last Post
Use VBA to compare Text Box contents between documents. Downunder Dave Word VBA 2 07-21-2021 02:16 AM
Compare 2007 documents with 2010 documents wardw Word 1 06-09-2016 02:29 PM
Macro to compare paragraph count between two documents compare each paragraph with the preceding paragraph cyraxote Word VBA 6 10-09-2015 08:03 AM
compare, match and count cell contents between sheets bobsone1 Excel 11 08-07-2014 10:34 PM
Macro to compare paragraph count between two documents Can you compare two word documents? (Automatically) admin4ever Word 2 05-17-2011 09:44 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 09:22 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft