Eu usaria uma segunda tabela com a lista dos descritivos e carregaria uma combobox no formulario para preencher a planilha.

Simples e de facil atualização.

Tem como fazer direto?

Ate da pra fazer direto mas neste caso se precisar inserir outra descriçao vai precisar editar o codigo por isso a lista.

Prudencio, obrigado pelo retorno!
Achei o código abaixo no site do Tomas, agora preciso adaptar a minha planilha! Se puder ajudar! Vou tentando aqui!

Obrigado

Private Sub UserForm_Initialize()
    Dim MyUniqueList As Variant, i As Long
    With Me.ListBox1
        .Clear    ' limpa o conteúdo do listbox
        MyUniqueList = UniqueItemList(Range("A1:A30"), True)
        For i = 1 To UBound(MyUniqueList)
            .AddItem MyUniqueList(i)
        Next i
        .ListIndex = 0    ' seleciona o primeiro item
    End With
End Sub
 
Private Function UniqueItemList(InputRange As Range, _
                                HorizontalList As Boolean) As Variant
    Dim cl As Range, cUnique As New Collection, i As Long, uList() As Variant
    Application.Volatile
    On Error Resume Next
    For Each cl In InputRange
        If cl.Formula <> "" Then
            cUnique.Add cl.Value, CStr(cl.Value)
        End If
    Next cl
    UniqueItemList = ""
    If cUnique.Count > 0 Then
        ReDim uList(1 To cUnique.Count)
        For i = 1 To cUnique.Count
            uList(i) = cUnique(i)
        Next i
        UniqueItemList = uList
        If Not HorizontalList Then
            UniqueItemList = _
            Application.WorksheetFunction.Transpose(UniqueItemList)
        End If
    End If
    On Error GoTo 0
End Function

Sub Retira_Repetidos()
Dim QtdeLinhas, x, z As Integer

QtdeLinhas = Lst_Historico.ListCount - 1

For x = 0 To QtdeLinhas
For z = 0 To QtdeLinhas
If x <> z Then
If z > QtdeLinhas Or x > QtdeLinhas Then Exit For
If Lst_Historico.List(x) = Lst_Historico.List(z) Then
Lst_Historico.RemoveItem (z)
QtdeLinhas = QtdeLinhas - 1
End If
End If
Next z
Next x

End Sub