Script example: Finding redundant spreadsheets

Search a typical company's main file server for documents matching *.xls, and a typical result will be a list of spreadsheets numbering tens of thousands.  This is a real obstacle to taking spreadsheet inventories, as required by Sarbanes Oxley and other regulatory regimes.

But many of those spreadsheets are merely copies of others.  OAK can identify spreadsheets that are not very different from each other.

This routine examines all the workbooks in a particular directory and identifies the one that is most like the active workbook.  Unlike a cell by cell comparison, this comparison takes advantages of OAK's ability to align spreadsheets before comparing them, so that spreadsheets that are only slightly dissimilar do not result in the identification of hundreds of unmatched cell references in formulas.

Option Explicit

Sub Main()

   Dim sDirectoryToSearch as String

   Dim sFileBeingConsidered As String, sFileClosest As String

   Dim dDifferencesInFileClosest As Double

   Dim r As ICompareResult, o As Operis_OAK.IOAKAPI

   Dim wbOriginal As Workbook, wbBeingConsidered As Workbook

   Set o = CreateObject("Operis.OAK.Connect")

   Set o.ExcelApplication = Application

   Set wbOriginal = ActiveWorkbook

   dDifferencesInFileClosest = 999999999 ' Assume there will be no more changes than this

   sDirectoryToSearch = Environ("UserProfile") & "\My Documents\"

   sFileBeingConsidered = Dir(sDirectoryToSearch & "\*.xls")

   While sFileBeingConsidered <> ""

       If sFileBeingConsidered <> wbOriginal.Name Then

           Set wbBeingConsidered = Workbooks.Open(sDirectoryToSearch & "\" & sFileBeingConsidered)

           Set r = o.Compare(wbOriginal, wbBeingConsidered, True, True, True, True, False, False, True, False, Range("A:B"), Nothing)

           If r.TotalDifferences < dDifferencesInFileClosest Then

               dDifferencesInFileClosest = r.TotalDifferences

               sFileClosest = sFileBeingConsidered

           End If

           r.ReportBook.Close        

      wbBeingConsidered.Close False

           o.UndoCompareModifications wbOriginal

       End If

       sFileBeingConsidered = Dir

   Wend

   MsgBox "Most similar file to '" & wbOriginal.Name & "' is '" & sFileClosest & "'", vbOKOnly, "OAK comparison"

End Sub

Tip: In this example, the bold True causes a report book to be written, which is then closed by the line also in bold, r.ReportBook.Close.  This is to give a pretext to illustrate use of the r.ReportBook method.  If the bold True is changed to False, no report book is generated, allowing the bold r.ReportBook.Close line to be omitted.  Not having to generate a report workbook would allow this code to run faster.