Comparing Two Worksheets and Updating

Question

I'm trying to compare two worksheets in Excel using VBA.

The Columns are exactly the same, with a different number of rows.

Sheet1 will be compared to Sheet2 and updated based on the data in Sheet2.

I need the routine to add new entries the bottom of the data in the first sheet, it needs to skip over rows that are in Sheet1, but not in Sheet2, and it needs to update existing rows if the cells in Sheet1 differ from Sheet2.

I'm using a dictionary object to compare 'keys'

This what I have so far and its not really working. I think its because its just checking and updating each line and opposed to checking the whole column first.

 Sub compareSheets()
        Dim dict1, dict2 As Object
        Set dict1 = CreateObject("Scripting.Dictionary")
        Set dict2 = CreateObject("Scripting.Dictionary")

        Dim maxRows1, maxRows2 As Long
        Dim i, ii, j, k As Integer

        maxRows1 = Worksheets("Sheet1").UsedRange.Rows.Count

        For i = 2 To maxRows1

          Dim cell1 As String

          cell1 = Worksheets("Sheet1").cells(i, 2).Text & " " & Worksheets("Sheet1").cells(i, 11).Text

            If Not dict1.exists(cell1) Then
                dict1.Add cell1, cell1
            End If

        Next i

        maxRows2 = Worksheets("Sheet2").UsedRange.Rows.Count

        For ii = 2 To maxRows2

            Dim cell2 As String

            cell2 = Worksheets("Sheet2").cells(ii, 11).Text

            If Not dict2.exists(cell2) Then
                dict2.Add cell2, cell2
            End If

        Next ii

        Dim rng As Range

        For j = 2 To maxRows2

            If Not dict1.exists(Worksheets("Sheet2").cells(j, 11).Text) Then
                Worksheets("Sheet2").Range("A" & j & ":" & "Z" & j).Copy
                Worksheets("Sheet1").Range("A" & maxRows1 + 1).Insert
                Worksheets("Sheet1").Range("A" & maxRows1 + 1).Interior.Color = RGB(255, 255, 0)
                Worksheets("Sheet1").Range("U" & maxRows1 + 1) = "INCH"
                Worksheets("Sheet1").Range("Q" & maxRows1 + 1) = "FPM"
                Worksheets("Sheet1").Range("S" & maxRows1 + 1) = "INCHES WIDE"

                Worksheets("Sheet2").Range("K" & j) = Replace(Worksheets("Sheet2").Range("K" & j), Worksheets("Sheet2").Range("B" & j), "")
                Worksheets("Sheet1").Range("K" & maxRows1 + 1) = Trim(Worksheets("Sheet2").Range("K" & j))

                maxRows1 = Worksheets("Sheet1").UsedRange.Rows.Count

            ElseIf Not dict2.exists(Worksheets("Sheet1").cells(j, 2).Text & " " & Worksheets("Sheet1").cells(j, 11).Text) Then

                j = j

            ElseIf dict1.exists(Worksheets("Sheet2").cells(j, 11).Text) Then
                For k = 3 To 26
                    If Not k = 11 Then
                        If Not Worksheets("Sheet1").cells(j, k).Text = Worksheets("Sheet2").cells(j, k).Text Then
                             Worksheets("Sheet1").cells(j, k) = Worksheets("Sheet2").cells(j, k)
                        End If
                    End If
                Next k
            End If

        Next j

did you step through code line by line to see exactly where its not performing as you would expect? — Scott Holtzman

AnalystCave.com AnalystCave.com · Accepted Answer · 2014-08-05T13:12:29

You can do it via Microsoft Query or my SQL Add-in:

(SELECT T1.TestName, T2.TestVal FROM [Sheet1$] as T1 INNER JOIN [Sheet2$] as T2 ON T1.TestName = T2.TestName) 
UNION ALL
(SELECT T2.TestName, T2.TestVal FROM [Sheet2$] AS T2 LEFT OUTER JOIN [Sheet1$] as T1 ON T1.TestName = T2.TestName WHERE T1.TestName IS NULL)
UNION ALL
(SELECT T1.TestName, T1.TestVal FROM [Sheet1$] AS T1 LEFT OUTER JOIN [Sheet2$] as T2 ON T1.TestName = T2.TestName WHERE T2.TestName IS NULL)

Comparing Two Worksheets and Updating

1 Answers