Sub stringSummary()

Dim wb As Workbook
Dim ws As Worksheet, wsT As Worksheet
Dim arr2, dict
Dim i%, elem As Variant, n&


Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet
Set wsT = wb.Worksheets(3)

Application.ScreenUpdating = False

With ws
    arr2 = .Range("A1", .Cells(Rows.Count, "B").End(xlUp)).Value
End With




Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = 1
For i = 1 To UBound(arr2)
    
    
    If Not dict.Exists(arr2(i, 1)) Then
    dict.Add key:=arr2(i, 1), item:=arr2(i, 2)
    Else:
         dict.item(key) = item
    End If
    
Next i


With wsT
For Each elem In dict.Items
    n = n + 1
    .Cells(n, 2) = elem
Next
n = 0
For Each elem In dict.Keys
    n = n + 1
    .Cells(n, 1) = elem
Next
End With

Application.ScreenUpdating = True

End Sub

Option Explicit 
Option Base 1 
 
Function ArraysDifference(primArray As Variant, secondArray As Variant) As Variant 
  Dim newItems() As String           'конечный массив 
  Dim item As Variant                'текущий элемент 
  Dim tempItems As New Collection    'временная коллекция 
  Dim count As Integer               'счётчик элементов 
 
  'заполняем коллекцию элементами первичного массива 
  For Each item In primArray 
    tempItems.Add item, item 
  Next item 
  'проходим по второму массиву и пытаемся добавить его элементы в коллекцию; 
  'если такой элемент уже добавлен в первом цикле, генерируется ошибка; 
  'если ошибки не произошло, добавляем новый элемент в конечный массив 
  count = 0 
  For Each item In secondArray 
    On Error Resume Next 
    tempItems.Add item, item 
    If Err = 0 Then 
      count = count + 1 
      ReDim Preserve newItems(count) 
      newItems(count) = item 
    End If 
    On Error GoTo 0 
  Next item 
  ArraysDifference = newItems 
End Function 
 
Sub TestArrayDifference() 
  Dim array1, array2 As Variant 
  Dim newEmploy, escEmploy As Variant 
  'сотрудники в начале недели 
  array1 = Array("Дима", "Вася", "Петя", "Костя", "Паша") 
  'сотрудники в конце недели 
  array2 = Array("Лёха", "Игорь", "Петя", "Костя", "Боря") 
  'новые сотрудники 
  newEmploy = ArraysDifference(array1, array2) 
  'выбывшие сотрудники 
  escEmploy = ArraysDifference(array2, array1) 
End Sub

Sub TestArrayDifference()
  Dim array1, array2 As Variant
  Dim result1, result2 As Variant
  Dim arr, arrSec
  
  With Workbooks("test.xlsm").Worksheets("Лист1")
array1 = .Range("B1", .Cells(.Rows.count, "A").End(xlUp)).Value
End With   
  With Workbooks("test.xlsm").Worksheets("Лист2")
array2 = .Range("B1", .Cells(.Rows.count, "A").End(xlUp)).Value
End With 
 
  result1 = ArraysDifference(array1, array2)
  'result2 = ArraysDifference(array2, array1)  
  
  With Workbooks("test.xlsm").Worksheets("разность").Cells(1, 1)
     .Value = result1
     End With
End Sub