Sub Trim_removeDupes()
Dim Cl As Range
Sheets("DeptXref").Select
With CreateObject("scripting.dictionary")
For Each Cl In Range("C1", Range("C" & Rows.Count).End(xlUp))
If Not .exists(Left(Cl.Value, 4)) Then .Add Left(Cl.Value, 4), Nothing
Next Cl
Sheets("Table Build").Range("D1:D" & .Count - 1) = Application.Transpose(.keys)
End With
End Sub