If 2 pairs of cells are not equal, do something in VBA - excel

Question

I have 2 tables in Excel. The itemx, attributex in attrDICTIONARY needs to be updated based on Sheet 2.
I want to go through each itemx, attributex in Sheet 2
If it is not found in attrDICTIONARY, add a new row with the missing itemx, attributex in
Note: These columns are sorted in alphabetical order A-Z by itemx. There are also a large number of entries in Sheet 2 relative to attrDICTIONARY.
attrDICTIONARY contains:
column1 column2
item1 attribute1
item2 attribute2
item4 attribute4
Sheet 2 contains:
column1 column2
item1 attribute1
item2 attribute2
item3 attribute3
item4 attribute4
I have tried this:
Sub addAttributesToAttrDICTIONARY()
'
' addAttributesToAttrDICTIONARY Macro
'
Sheet2LastRow = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
attrDictionaryLastRow = Worksheets("attrDICTIONARY").Range("C" & Rows.Count).End(xlUp).Row
Dim i As Integer
Dim j As Integer
j = 1
For i = 2 To Sheet2LastRow
While j <= attrDictionaryLastRow
incrementj:
j = j + 1
If (StrComp(Worksheets("Sheet2").Cells(i, 1).Value, Worksheets("attrDICTIONARY").Cells(j, 2).Value)) = 0 And (StrComp(Worksheets("Sheet2").Cells(i, 2).Value, Worksheets("attrDICTIONARY").Cells(j, 3).Value)) = 0 Then
GoTo Nexti
Else
Worksheets("attrDICTIONARY").Rows(j).Insert
Worksheets("attrDICTIONARY").Cells(j, 2).Value = Worksheets("Sheet2").Cells(i, 1).Value
Worksheets("attrDICTIONARY").Cells(j, 3).Value = Worksheets("Sheet2").Cells(i, 2).Value
attrDictionaryLastRow = attrDictionaryLastRow + 1
GoTo Nexti
End If
Wend
Nexti:
Next i
End Sub
Since the tables are sorted, I am just checking if they are the same, if not add a row above and add the appropriate values.
This code works up until about 4000 thousand items. At that point, it seems like the code stops checking for duplicates and just adds new rows for everything, pushing the original values down to the bottom and creating duplicates. I checked using a different coloured font for new items.
Any help would be appreciated. Thanks.

Answer 1

Give this a try:
Sub addAttributesToAttrDICTIONARY()
Dim wb As Workbook
Dim wsAttr As Worksheet
Dim wsData As Worksheet
Dim rAttr As Range
Dim aData As Variant
Dim aAdd() As Variant
Dim AddIndex As Long
Dim i As Long, j As Long
Set wb = ActiveWorkbook
Set wsAttr = wb.Sheets("attrDICTIONARY")
Set wsData = wb.Sheets("Sheet2")
Set rAttr = wsAttr.Range("B2", wsAttr.Cells(wsAttr.Rows.Count, "C").End(xlUp))
aData = wsData.Range("A2", wsData.Cells(wsData.Rows.Count, "A").End(xlUp)).Resize(, 2).Value
ReDim aAdd(1 To 65000, 1 To UBound(aData, 2))
For i = 1 To UBound(aData, 1)
If WorksheetFunction.CountIfs(rAttr.Columns(1), aData(i, 1), rAttr.Columns(2), aData(i, 2)) = 0 Then
AddIndex = AddIndex + 1
For j = 1 To UBound(aData, 2)
aAdd(AddIndex, j) = aData(i, j)
Next j
End If
Next i
If AddIndex > 0 Then
rAttr.Offset(rAttr.Rows.Count).Resize(AddIndex, UBound(aAdd, 2)).Value = aAdd
With wsAttr.Range("B2", wsAttr.Cells(wsAttr.Rows.Count, "C").End(xlUp))
.Sort .Resize(, 1), xlAscending, .Offset(, 1).Resize(, 1), , xlAscending, Header:=xlNo
End With
End If
End Sub