Алгоритм элементарный:  
 
1 берём данные в массив  
2 объявляем пустой массив нужного размера (исходя из уже определённого количества данных)  
3 перебор исходного массива, заносим уникальные в словарь или коллекцию, сразу копируем данные в итоговый массив, двигая индекс  
4 в случае повтора в словаре/коллекции не копируем и не двигаем :)  
На коллекции даже будет быстрее.  
 
5 выгрузка заполненной части массива.

Ерунда, сможете. Сейчас, погодите...

Sub tt()  
   Dim a(), i&, ii&, t$  
   a = [a1].CurrentRegion.Value ' или любым другим способом определить диапазон и взять его value
   ReDim b(1 To UBound(a), 1 To 2)    ' вот такой нужен на выходе  
     
   With CreateObject("scripting.dictionary")    'будем юзать словарь, с ним проще код :)  
       .CompareMode = 1    'сравнение без учёта регистра  
       For i = 1 To UBound(a)    'первая строка не нужна, но нехай буде родной заголовок :)  
           t = Left(a(i, 1), 4) & "|" & a(i, 3)    'получаем значение вида aaaa|Banana  
           If Len(t) > 1 Then 'если в переменной не только "|", но можно и иначе отсеять пробелы  
           If Not .exists(t) Then 'если нет в словаре  
               .Item(t) = 0& 'заносим  
               ii = ii + 1 'увеличиваем индекс  
               b(ii, 1) = Left(a(i, 1), 4): b(ii, 2) = a(i, 3) 'копируем  
           End If  
           End If  
       Next  
   End With  
     
   If ii > 0 Then [h1].Resize(ii, 2) = b 'выгрузка, если есть что выгружать
     
End Sub