Issues with comparing two workbooks

Question

I am trying to compare a worksheet from two different workbooks and cant seem to get this right. I have read many times that using arrays are inefficient but every time a try the suggested solutions I get nowhere.

The following problems are happening Runtime error 9 subscript out of range

when I debug it is related to filling the array, but it should not be out of range i from 1 to (in this case_ 1487) but error on 1486 so I am still within the range.

I want to skip this error so I can see if there are any other problems so at the top I have on error goto 0

Bypassing the error the program continues but will not print the different records. If anyone can take a look at this I would be much appreciated.

I can send you the files that I am working with at your request Also the compare code is below

Option Base 1

Sub GatherInfo()

Dim CurrentRecord() As Variant
Dim PreviousRecord() As Variant
Dim ChangedRecord() As Variant

Dim WasCancled As Integer
Dim RecordChange As Integer

Dim CurrentFile As String
Dim PreviousFile As String
Dim CurrentWB As Excel.Workbook
Dim PreviousWB As Excel.Workbook

Dim OldRC As Integer
Dim NewRC As Integer
Dim OldCC As Integer
Dim NewCC As Integer
Dim MaxRC As Integer
Dim MaxCC As Integer



'Allow user to select the older version of the dBase

Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False  'Allow only one fiel selection

'Application.FileDialog(msoFileDialogOpen).InitialFileName = "C:\Users\bkrukowski\Desktop\Paving DataBase" 'Point to the file folder

Application.FileDialog(msoFileDialogOpen).Title = "SELECT THE OLDER VERSION FOR COMPARISON:" ' Create a title in open dialog box to specify what file to open

WasCancled = Application.FileDialog(msoFileDialogOpen).Show ' Show the selection

If WasCancled <> 0 Then

PreviousFile = Application.FileDialog(msoFileDialogOpen).SelectedItems(1) ' PreviousFile now has the address of the file

Else

Exit Sub

End If


'Allow user to select current version of dBase

Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False 'Allow only one fiel selection

'Application.FileDialog(msoFileDialogOpen).InitialFileName = "C:\Users\bkrukowski\Desktop\Paving DataBase" 'Point to the file folder

Application.FileDialog(msoFileDialogOpen).Title = "SELECT THE NEWER VERSION FOR COMPARISON:" ' Create a title in open dialog box to specify what file to open

WasCancled = Application.FileDialog(msoFileDialogOpen).Show ' Show the selection

If WasCancled <> 0 Then

CurrentFile = Application.FileDialog(msoFileDialogOpen).SelectedItems(1) ' CerrentFile now has the address of the file

Else

Exit Sub

End If

Application.ScreenUpdating = False


'Open the previous version

Set PreviousWB = Workbooks.Open(PreviousFile)

'Determine the Size of Array needed

OldRC = PreviousWB.Sheets("Export_Output").UsedRange.Rows.Count
OldCC = PreviousWB.Sheets("Export_Output").UsedRange.Columns.Count

PreviousWB.Worksheets("Export_Output").Range("A1").Activate


ReDim PreviousRecord(OldRC, OldCC)

' Fill the array
For i = 1 To OldRC

    For j = 1 To OldCC

        PreviousRecord(i, j) = ActiveCell.Value

        ActiveCell.Offset(0, 1).Activate

        If j = OldCC Then

         ActiveCell.Offset(1, -j).Activate


         End If


        Next j

Next i


'Open the current version
Set CurrentWB = Workbooks.Open(CurrentFile)


'Determine the Size of Array needed

NewRC = CurrentWB.Sheets("Export_Output").UsedRange.Rows.Count
NewCC = CurrentWB.Sheets("Export_Output").UsedRange.Columns.Count

CurrentWB.Worksheets("Export_Output").Range("A1").Activate


ReDim CurrentRecord(NewRC, NewCC)

'Fill the Array

For i = 1 To NewRC

    For j = 1 To NewCC

        PreviousRecord(i, j) = ActiveCell.Value

        ActiveCell.Offset(0, 1).Activate

        If j = NewCC Then

         ActiveCell.Offset(1, -j).Activate


         End If


        Next j

Next i

'Ensure array dimentions are same

If Not OldRC = NewRC Then

    If NewRC > OldRC Then

        ReDim Preserve PreviousRecord(NewRC, NewCC)

        MaxRC = NewRC

    Else

        ReDim Preserve CurrentRecord(OldRC, OldCC)

        MaxRC = OldRC

    End If

    Else

        MaxRC = NewRC
End If


    MaxCC = NewCC

RecordChange = 0
l = 1
'Begin comparing Data - If any item on a Row is diffrent from the previous copy the entrie row into new array

For i = 1 To MaxRC
    For j = 1 To MaxCC

        If Not PreviousRecord(i, j) = CurrentRecord(i, j) Then

            RecordChange = RecordChange + 1

            ReDim Preserve ChangedRecord(RecordChange, MaxCC)

            For k = 1 To MaxCC

                ChangedRecord(l, k) = PreviousRecord(i, k)
                ChangedRecord(l + 1, k) = CurrentRecord(i, k)
                l = l + 2

                Next k
            End If

            Next j
            Next i


Workbooks("CompareThis").Sheets("Sheet1").Activate
Range("A1").Activate

For i = 1 To RecordChange

    For j = 1 To MaxCC

        ActiveCell.Value = ChangedRecord(i, j)
        ActiveCell.Offset(1, j).Activate
    Next j
    Next i


Application.ScreenUpdating = True





End Sub

Thank you for any help you can offer.

Please read [How to create a Minimal, Complete, and Verifiable example](http://stackoverflow.com/help/mcve) and edit your question. — Scott Holtzman, Sep 07 '16 at 19:56
One suggestion is to separate your code into different functions/subs based on what is needed. For example, the code for the user to use a `FileDialog` to select previous and current dBase files could be collapsed into a single functional call (probably returning the opened workbook itself). Then your range comparison code can be isolated in a `Function` or `Sub` as well. You can capture your `Range` into an array in a single statement (see [this](http://stackoverflow.com/documentation/excel-vba/1107/vba-best-practices/3830/work-with-arrays-not-with-ranges#t=201609072038348917869)) — PeterT, Sep 07 '16 at 20:39

score 1 · Answer 1 · edited May 23 '17 at 11:48

This code has several indexing errors. The first one is here:

OldRC = PreviousWB.Sheets("Export_Output").UsedRange.Rows.Count
OldCC = PreviousWB.Sheets("Export_Output").UsedRange.Columns.Count
'...
ReDim PreviousRecord(OldRC, OldCC)
'...

NewRC = CurrentWB.Sheets("Export_Output").UsedRange.Rows.Count
NewCC = CurrentWB.Sheets("Export_Output").UsedRange.Columns.Count
'...
ReDim CurrentRecord(NewRC, NewCC)

For i = 1 To NewRC
    For j = 1 To NewCC
        PreviousRecord(i, j) = ActiveCell.Value

You're setting the size of PreviousRecord based on OldRC and OldCC, but your loop counters are based on NewRC and NewCC.

The second one is here. Only the last bound of an array can be changed with the Preserve keyword. See this answer for an explanation of why.

If NewRC > OldRC Then
    ReDim Preserve PreviousRecord(NewRC, NewCC)
    MaxRC = NewRC
Else
    ReDim Preserve CurrentRecord(OldRC, OldCC)
    MaxRC = OldRC
End If

If your code makes it far enough, you pretty much ensure the same error as above here:

For i = 1 To MaxRC
    For j = 1 To MaxCC
        If Not PreviousRecord(i, j) = CurrentRecord(i, j) Then
            RecordChange = RecordChange + 1
            ReDim Preserve ChangedRecord(RecordChange, MaxCC)

In this section, you don't do anything to prevent l from over-running the array bound - it is based entirely on how many mismatches you have:

For k = 1 To MaxCC
    ChangedRecord(l, k) = PreviousRecord(i, k)
    ChangedRecord(l + 1, k) = CurrentRecord(i, k)
    l = l + 2
Next k

I have corrected the indexing errors by finding the larger row count and reDim the array before filling it. — BKruk, Sep 09 '16 at 17:33
As for the last correction (Over-running the array bound) My solution is to instead of filling a 2D Array with both records I will fill an array with row index numbers and then use that to copy. The execution is very slow, I think I am making this much harder than it should be. The objective was to compare two exported dBase files (from ESRI AcrMap) and put any records that differ next to each other so I can easily see what has changed. — BKruk, Sep 09 '16 at 17:43

Issues with comparing two workbooks

1 Answers1