Update Worksheet by comparing it to another Worksh

Question

I have an excel Worksheet ("Sheet1") that I need to compare with another Worksheet ("Sheet2").

Both Worksheets are formatted exactly alike. (i.e. columns are the same, with the same headers)

When comparing Sheet1 with Sheet2, I need to check for updates to existing records.

Also check for new records in Sheet2 that don't exist in Sheet1, and append them to the bottom of Sheet1.

Some Columns in Sheet 2 are completely blank and don't need to be checked.

Column 2 would be the "Key"

Also keep in mind that there are over 7000 rows in each worksheet.

Update #1:

Using the dictionary object, I came up with this. However, it doesn't seem to find any new entries. Am I doing something wrong?

Sub createDictionary()
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim maxRows1, maxRows2 As Long
    Dim i, j As Integer
    Dim SheetOne, SheetTwo As Worksheet

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

    Set SheetOne = Sheet1
    Set SheetTwo = Sheet2

    For i = 2 To maxRows1

        If Not dict.exists(SheetOne.Cells(i, 2).Value + " " + SheetOne.Cells(i, 11).Value) Then
            dict.Add CStr(SheetOne.Cells(i, 2).Value) + " " + SheetOne.Cells(i, 11).Value, i
        End If

    Next i

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

    For j = 2 To maxRows2

        If Not dict.exists(Sheet2.Cells(j, 2).Value) Then
            SheetTwo.Range("A" & j & ":" & "Z" & j).Copy
            SheetOne.Range("A" & maxRows1 + 1).Insert Shift:=xlDown
            SheetOne.Range("A" & maxRows1 + 1).Interior.Color = RGB(200, 200, 200)
        End If

    Next j

    Set dict = Nothing
End Sub

Answer 1

I repeat this often across this forum :), however, such operations are much more easy to handle using SQL.

I would either use Microsof Query (Excel Data->Get External Data->From Other sources->From Microsoft Query) OR I suggest using my SQL Add-In to Excel: http://blog.tkacprow.pl/?page_id=130

Seems like you need to need to use the JOIN operator to find the changes between Sheets 1 and 2. Then using a UNION operator you join a second SELECT with a LEFT OUTER JOIN to add the additional new rows.

Answer 2

Try using a dictionary object, it doesn't have a limit on how much it can hold (only limit is your computer)

I would loop through sheet1, add each key to the dictionary and map it to a collection that stores the rowIndex and the hash made from the rows values. Then loop through the keys in sheet2 and see if each key exists in the dictionary; if it doesn't, copy the row to sheet1. If the key does exist, then hash the row in sheet2 and compare to the dictionary item, if they are different you know you need to update the row.

To copy a row and paste it really quickly, you can simply access a ow's value2 property. This will be useful when appending + when updating

Here's some test code to get you started.

Sub loopCellInColumn()
    Dim cell As Object
    Dim sheet As Worksheet
    Dim rng As Range
    Set sheet = ActiveSheet
    Set rng = sheet.UsedRange.Columns("A").Cells

    For Each cell In rng
        Row = cell.Row
        cell.Value = "Hello World" & Row
    Next cell
End Sub

and for using a dictionary:

Sub createDictionary()
    Dim dict As Object
    Dim value As Collection
    Set dict = CreateObject("Scripting.Dictionary")

    Key = "hello"
    Set value = New Collection
    value.Add 100, "row"
    value.Add "A2D121E4", "hash"
    dict.Add Key, value

    MsgBox "key exists: " & dict.exists(Key) & vbNewLine & "value: " & dict(Key).Item("hash")
End Sub

copy + paste using value2:

Sub test()
    ActiveSheet.Rows(1).Value2 = ActiveSheet.Rows(2).Value2
End Sub

ex of getting a row as string:

Sub getRowAsString()
    Dim cell As Object
    Dim sheet As Worksheet
    Dim str As String
    Dim arr() As Variant
    Dim arr2() As Variant
    Dim printCol As Integer

    Set sheet = ActiveSheet
    printCol = sheet.UsedRange.Columns.Count + 1

    For Each cell In sheet.UsedRange.Rows
        arr = cell.Value2
        ReDim arr2(LBound(arr, 2) To UBound(arr, 2))

        For i = LBound(arr, 2) To UBound(arr, 2)
            arr2(i) = arr(1, i)
        Next i

        str = Join(arr2, ", ")
        ActiveSheet.Cells(cell.Row, printCol).Value = str
    Next cell
End Sub

Here is a post of getting a hash value from string, includes vba code:

All of the steps I listed have numerous posts supporting them, so resources won't be an issue