1

I am creating a code that compares new and old lists in order to find items that exists in column B but not in column E and vice versa. I do this for multiple lists.

In Excel I use the function in column A and drag down

=IF(ISNA(VLOOKUP(B4,$E$4:$E$65537,1,FALSE)),"0","1")

Where B contains an identifier for the old list, C contains a name for the identifier for the old list, and E contains the identifier for the new list.

Example of data

Option Explicit
Option Base 0

' **** Declaring variables ****
' Worksheets and workbooks
Public ws_C                 As Worksheet
Public wkb                  As Workbook

' Integers
Public lr_pos_old           As Integer
Public lr_pos_new           As Integer
Public lr_neg_old           As Integer
Public lr_neg_new           As Integer
Public oldColumn            As Integer
Public newColumn            As Integer
Public StartRow             As Integer
Public i                    As Integer
Public j                    As Integer
Public colSpace             As Integer

' Arrays
Public ListArrOld           As Variant
Public ListArrNew           As Variant



Sub main()
' This sub sets up general declarations and options

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wkb = ThisWorkbook
Set ws_C = wkb.Sheets("Comparison")

StartRow = 4
colSpace = 6
oldColumn = 2
newColumn = 5
lr_pos_old = ws_C.Range("C12").End(xlDown).Row ' Lastrow for old positive list
lr_pos_new = ws_C.Range("F12").End(xlDown).Row ' Lastrow for new positive list
lr_neg_old = ws_C.Range("I12").End(xlDown).Row ' Lastrow for old negative list
lr_neg_new = ws_C.Range("L12").End(xlDown).Row ' Lastrow for new negative list
ListArrOld = Array(lr_pos_old, lr_neg_old)
ListArrNew = Array(lr_pos_new, lr_neg_new)

' Calling subs
Call CompareLists


Application.StatusBar = False
ws_C.Activate

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Sub CompareLists()
' This sub compares the positive and negative lists from the old and new boardmeeting report

Application.StatusBar = "Comparing new and old lists ..."

' Comparing old vs new list: Value 1 if included in the new list
With Application.WorksheetFunction
    For j = LBound(ListArrOld) To UBound(ListArrOld)
        For i = StartRow To ListArrOld(j)
            ws_C.Cells(i, 1 + j * colSpace) = _
            .If(.IsNA(.VLookup(ws_C.Cells(i, oldColumn + j * colSpace), _
            ws_C.Range(ws_C.Cells(StartRow, newColumn + j * colSpace), ws_C.Cells(ListArrNew(j), newColumn + j * colSpace)), 1, False)), "0", "1")
        Next i ' Next row
    Next j ' Next list
End With


' Comparing new vs old: Value 1 if included in the old list
' Similar code

End Sub

I expect column A to get values of 0 and 1 but instead my code fails at

ws_C.Cells(i, 1 + j * colSpace) = _
            .If(.IsNA(.VLookup(ws_C.Cells(i, oldColumn + j * colSpace), _
            ws_C.Range(ws_C.Cells(StartRow, newColumn + j * colSpace), ws_C.Cells(ListArrNew(j), newColumn + j * colSpace)), 1, False)), "0", "1")

with the

run-time error 438 "object does not support this property or method".

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
BlackBear
  • 385
  • 1
  • 5
  • 25
  • There is no `WorksheetFunction` called `If`. The closest is VBA's `IIf`, but will [evaluate both arguments](https://stackoverflow.com/a/13050787/11683) at all times. – GSerg May 13 '19 at 07:47
  • If you are trying to get a `VLOOKUP` but without formulas, you should check out dictionaries. Store 1 list into a dictionary and then use the `If Dictionary(Value).Exists` function to get what you need. Is faster this way, but dictionaries are case sensitive. – Damian May 13 '19 at 07:48
  • You could use application.evaluate with your formula, but for checking if an item exists you could also use a plain countif =N(COUNTIF($E$4:$E$65537,B4)>0) – EvR May 13 '19 at 08:03

2 Answers2

0

This should do the trick and do it fast:

Option Explicit
Sub CompareList()

    Dim LastRow As Long, Col As Byte, i As Long, arrOld, arrNew
    Dim DictOld As New Scripting.Dictionary
    Dim DictNew As New Scripting.Dictionary


    With ThisWorkbook.Sheets("SheetName") ' change this to your sheet name

        'Store the old list into the array and the items into the dictionary
        Col = .Cells.Find("Old List").Column 'Find the list column
        LastRow = .Cells(.Rows.Count, Col).End(xlUp).Row 'Find the last row for the list
        arrOld = .Range(.Cells(3, Col), .Cells(LastRow, Col + 1)).Value 'Store the data into the array
        For i = LBound(arrOld) To UBound(arrOld)
            DictOld.Add arrOld(i, 1), i
        Next i

        'Store the new list into the array and the items into the dictionary
        Col = .Cells.Find("New List").Column 'Find the list column
        LastRow = .Cells(.Rows.Count, Col).End(xlUp).Row 'Find the last row for the list
        arrNew = .Range(.Cells(3, Col), .Cells(LastRow, Col + 1)).Value 'Store the data into the array
        For i = LBound(arrNew) To UBound(arrNew)
            DictNew.Add arrNew(i, 1), i
        Next i

        'Compare the lists
        For i = LBound(arrOld) To UBound(arrOld)
            If Not DictNew.Exists(arrOld(i, 1)) Then
                arrOld(i, 2) = "Exists in old but not in new"
            Else
                arrOld(i, 2) = "Exists in both"
            End If
        Next i
        Col = .Cells.Find("Old List").Column 'Find the list column
        LastRow = .Cells(.Rows.Count, Col).End(xlUp).Row 'Find the last row for the list
        .Range(.Cells(3, Col), .Cells(LastRow, Col + 1)).Value = arrOld


        For i = LBound(arrNew) To UBound(arrOld)
            If Not DictOld.Exists(arrNew(i, 1)) Then
                arrNew(i, 2) = "Exists in new but not in new"
            Else
                arrNew(i, 2) = "Exists in both"
            End If
        Next i
        Col = .Cells.Find("New List").Column 'Find the list column
        LastRow = .Cells(.Rows.Count, Col).End(xlUp).Row 'Find the last row for the list
        .Range(.Cells(3, Col), .Cells(LastRow, Col + 1)).Value = arrNew

End Sub
Damian
  • 5,152
  • 1
  • 10
  • 21
  • This looks neat. When I try to use the code I get an overflow error. EDIT: I changed it from Byte to integer and it works. – BlackBear May 13 '19 at 08:57
  • @BlackBear thought your columns were like the sample so Byte (255) should be enough. Glad it helped. Consider marking this as answer so others may find it. – Damian May 13 '19 at 09:18
0

Apart from the solution provided by Damian, I solved my problem by changing the line

ws_C.Cells(i, 1 + j * colSpace) = _
            .If(.IsNA(.VLookup(ws_C.Cells(i, oldColumn + j * colSpace), _
            ws_C.Range(ws_C.Cells(StartRow, newColumn + j * colSpace), ws_C.Cells(ListArrNew(j), newColumn + j * colSpace)), 1, False)), "0", "1")

to the following:

 ws_C.Cells(i, 1 + j * colSpace) = _
            IIf(Application.IsNA(Application.VLookup(ws_C.Cells(i, oldColumn + j * colSpace), _
            ws_C.Range(ws_C.Cells(startrow, newColumn + j * colSpace), ws_C.Cells(ListArrNew(j), newColumn + j * colSpace)), 1, False)), "0", "1")

and removing the with clause in the beginning. As mentioned in this thread using Application without worksheetfunction I avoid raising the error and interruption my code.

BlackBear
  • 385
  • 1
  • 5
  • 25