Comparing Column A to B and B to A and Copy Entire Row of Missing and Added to New Sheets Respectively

Question

I'm trying to figure out the best way to attack this problem and my head is spinning a bit, I'm not sure if I should use For Each Cell or Arrays or Collections to do some comparisons and copy entire rows to new sheets. I'd like to use Arrays but my code only uses the values of column but then I have to go back and re-loop through column to find "missing values" and copy entire row which seems to defeat part of the point of using arrays (speed/efficiency).

I'm looking for advice on the best way to tackle this issue, but I'll post my array code as well.

First off, example data:

Sheet1:

Sheet2:

The idea is Sheet1 is yesterdays report and sheet2 is todays.

My goal is two more sheets (or one combo sheet, but that seems unnecessary hard as I need to do total calculations on each result sheet search results respectively by totaling one of the columns, but not the value in column A)

ItemsAdded:

A6 AV6

ItemsRemoved:

A5 AV5

So basically it is finding what items where removed and what was added comparing sheet2 to sheet1 column A.

So far I was able to get that part, without the row values and I'm really wondering if I'm attacking this correctly.

IE: This gets the missing/added items. Now I need to go and fetch the entire row for the values in each sheet, but am unsure how and the code is starting to look long and repeating.

Public Function RangeToArray(Rng As Range) As Variant
    Dim i As Long, r As Range
    ReDim arr(1 To Rng.Count)

    i = 1
    For Each r In Rng
        arr(i) = r.Value
        i = i + 1
     Next r

    RangeToArray = arr
End Function
Public Sub Compare_Columns_A_and_B_with_Arrays()

 Dim wb As Workbook, wsA As Worksheet, wsB As Worksheet, Missing As Worksheet, Added As Worksheet
 Set wb = ActiveWorkbook
 Set wsA = wb.Worksheets("Sheet1")
 Set wsB = wb.Worksheets("Sheet2")

 Set Missing = wb.Worksheets("Missing")
 Set Added = wb.Worksheets("Added")

Dim lRowA As Long
 lRowA = wsA.Cells(Rows.Count, 1).End(xlUp).Row
 Dim sourceArray As Variant, srcrng As Range
 Set srcrng = wsA.Range("A1:A" & lRowA)
 sourceArray = RangeToArray(srcrng)

Dim lRowB As Long
 lRowB = wsB.Cells(Rows.Count, 2).End(xlUp).Row
 Dim verifyArray As Variant, verifyrng As Range
 Set verifyrng = wsB.Range("A1:A" & lRowB)
 verifyArray = RangeToArray(verifyrng)



For Each arrval In sourceArray
 IsInArray = (UBound(Filter(verifyArray, arrval)) > -1)
 If IsInArray = False Then
  'Debug.Print arrval
  Dim lRowMissing As Long
  lRowMissing = Missing.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
  Missing.Range("A" & lRowMissing).Value = arrval
 End If
Next arrval

For Each arrval In verifyArray
 IsInArray = (UBound(Filter(sourceArray, arrval)) > -1)
 If IsInArray = False Then
  'Debug.Print arrval
  Dim lRowAdded As Long
  lRowAdded = Added.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
  Added.Range("A" & lRowAdded).Value = arrval
 End If
Next arrval


End Sub

Answer 1

Assuming that you want to achieve something like this:

In a Sheet1 and Sheet2 there are headers (in my case i've used Header 1 and Header 2 .

In a result sheet:

1. Yesterday column holds an information about count of A(x) data in Sheet1 .
2. Today column holds an information about count of A(x) data in Sheet2 .

I have used below code:

Option Explicit

Sub CompareData()
    Dim wbk As Workbook
    Dim wshYesterday As Worksheet, wshToday As Worksheet, wshResult As Worksheet
    Dim i As Integer, j As Integer, k As Integer
    
    On Error Resume Next
    Set wbk = ThisWorkbook
    Set wshResult = wbk.Worksheets("Result")
    
    On Error GoTo Err_CompareData

    If Not wshResult Is Nothing Then
        Application.DisplayAlerts = False
        wbk.Worksheets("Result").Delete
        Application.DisplayAlerts = True
    End If
    Set wshYesterday = wbk.Worksheets("Sheet1")
    Set wshToday = wbk.Worksheets("Sheet2")
    Set wshResult = wbk.Worksheets.Add(After:=wshToday)
    wshResult.Name = "Result"
    wshResult.Range("A1") = "Header 1"
    wshResult.Range("B1") = "Header 2"
    wshResult.Range("C1") = "Yesterday"
    wshResult.Range("D1") = "Today"
    'find last entry in yesterdays data
    i = wshYesterday.Range("A" & wshYesterday.Rows.Count).End(xlUp).Row
    j = 2
    'copy into result sheet
    wshYesterday.Range("A2:B" & i).Copy wshResult.Range("A" & j)
    j = j + i - 1
    'find last entry in todays data and copy into result sheet
    i = wshToday.Range("A" & wshToday.Rows.Count).End(xlUp).Row
    wshToday.Range("A2:B" & i).Copy wshResult.Range("A" & j)
    'remove duplicates
    i = wshResult.Range("A" & wshResult.Rows.Count).End(xlUp).Row
    wshResult.Range("A2:B" & i).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
    j = 2
    i = wshResult.Range("A" & wshResult.Rows.Count).End(xlUp).Row
    Do While j <= i
        'count values stored in column #1 in yesterdays data
        k = Application.WorksheetFunction.CountIf(wshYesterday.UsedRange, wshResult.Range("A" & j))
        wshResult.Range("C" & j) = k
        'count todays data
        k = Application.WorksheetFunction.CountIf(wshToday.UsedRange, wshResult.Range("A" & j))
        wshResult.Range("D" & j) = k
        j = j + 1
    Loop

Exit_CompareData:
    On Error Resume Next
    Set wshYesterday = Nothing
    Set wshToday = Nothing
    Set wshResult = Nothing
    Set wbk = Nothing
    Exit Sub

Err_CompareData:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_CompareData

End Sub

Feel free to improve it to your needs.

Answer 2

Hard to know exactly what you want, but here is a Power Query solution (available in Excel 2010+) that creates a table summarizing what's been removed and/or added.

I assumed your data was in tables named Yesterday and Today . Change the table names in the Source = lines to match your real data.

M-Code

let
   //Read in the data tables
    Source = Excel.CurrentWorkbook(){[Name="Yesterday"]}[Content],
    Yesterday = Table.TransformColumnTypes(Source,{{"Column1", type text}, {"Column2", type text}}),
    Source2 = Excel.CurrentWorkbook(){[Name="Today"]}[Content],
    Today = Table.TransformColumnTypes(Source2,{{"Column1", type text}, {"Column2", type text}}),

    /*Using the appropriate JoinKind, create two different tables for
      itemsAdded and itemsRemove*/
        itemsAddedTBL = Table.NestedJoin(Today,"Column1",Yesterday,"Column1","TBL",JoinKind.LeftAnti),

        //Remove the unneeded TBL column
        itemsAdded = Table.RemoveColumns(itemsAddedTBL,"TBL"),

        //Add a column stating "Added"
        itemsAddedLBL = Table.AddColumn(itemsAdded,"Add/Remove", each "Added", type text),

        //Repeat the above for removed items
        itemsRemovedTBL = Table.NestedJoin(Yesterday,"Column1",Today,"Column1","TBL",JoinKind.LeftAnti),
        itemsRemoved = Table.RemoveColumns(itemsRemovedTBL,"TBL"),
        itemsRemovedLBL = Table.AddColumn(itemsRemoved, "Add/Remove", each "Removed",type text),

        //combine (append) the two tables into one
        comb = Table.Combine({itemsAddedLBL,itemsRemovedLBL})       

in
    comb

Answer 3

I actuallaly ended up using @AceErno's comment and using AutoFilter to pull the EntireRows of the data that was found by comparing arrays using the code in my original question. I'm not sure happy with my code, but it works and I can look into that later when I am feeling up for it.