VBA loop through column and store values in an array - excel

Question

I have my column B, starting from cell 2 (because of the header) containing codes of type String. I would like to get a list of these codes. However, these codes are repeated a number of times. So I would like to loop through my column B and add to my array of codes whenever a new one is encountered, if that makes sense.
Here is my code. How can this be done ? Thanks in advance.
Sub List()
Dim listCodes() As String
With Worksheets("My sheet)
nbr_lines = .Rows.Count
Dim i As Long
val_old = .Cells(2, 2).Value
listCodes(1) = val_old
For i = 2 To nbr_lines
val_new = .Cells(i + 1, 2).Value
While val_old = val_new
val_old = val_new
Wend
listCodes(i) = val_new
val_old = val_new
Next i
End With
End Sub

Answer 1

As mentioned in my comment, I'd suggest a dictionary. Drop the entire column into an array for speedy processing first, then throw it all in the dictionary:
Sub List()
Dim listCodes() As Variant
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim nbr_lines As Long
With Worksheets("My sheet")
'Get last used line and throw values in array;
nbr_lines = .Cells(.Rows.Count, 2).End(xlUp).Row
listCodes = .Range("B2:B" & nbr_lines).Value
'Loop array instead of cells for speed. Add all unique items into dictionary;
For Each el In listCodes
dict(el) = ""
Next
'Add the content of the dictionary to the sheet;
.Range("C2").Resize(dict.Count).Value = Application.Transpose(dict.Keys)
End With
End Sub
Note: This can also be achieved outside of VBA through easy formulae like the UNIQUE() function.

Answer 2

You can use dictionary approach. Below sub will copy only unique items to column D. Modify codes as your need.
Public Sub CopyUniqueOnly()
Dim i As Long
Dim currCell As Range, dict As Object
Set dict = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Worksheets("Sheet1")
For Each currCell In .Range("B2", .Cells(.Rows.Count, 2).End(xlUp))
If Not dict.exists(currCell.Value) And Not IsEmpty(currCell) Then
dict.Add currCell.Value, currCell.Value
End If
Next currCell
End With
Range("D2").Resize(dict.Count) = Application.Transpose(dict.keys)
End Sub