Código no busca comenzando en cero

Expertos tengo este código y lo que hace es buscar el mismo numero de 4 cifras en diferentes formas combinando sus mismas 4 cifras

Me explico si busco el 3456 el código me arrojaría el 5643 o el 4635 o 3645

Pero el problema es que al hacer una búsqueda comenzando con el cero

0123 solo busca combinaciones con el 123

Dim Celda As Range, Texto As String
Sub coincidenxias()
Application.ScreenUpdating = False
Columns("DA:DA").ClearContents
Range("A:CZ").Interior.Color = xlNone
x = 2
For Each Celda In Range("F1:W40")
If Trim(Celda) <> "" Then
If Contar = Len([DB1]) Then
Celda.Interior.Color = vbYellow
Range("DA" & x) = Celda
x = x + 1
End If
End If
Next
End Sub
'---------------------------------
Private Function Contar()
Texto = Celda
For x = 1 To Len([DB1])
i = InStr(Texto, Mid([DB1], x, 1))
If i > 0 Then
Texto = Replace(Texto, Mid([DB1], x, 1), "", 1, 1)
Contar = Contar + 1
End If
Next
End Function