Keep leading zero in vba

Hi , I need help for my vba code . I want to keep the leading zero after doing permutation . What should i do ? Thanks

Sub Test()
  Dim Number As String
  Dim Numbers, Data, Item, Value
  Dim C As Collection
  Dim Dict As Object 'Scripting.Dictionary
  Dim i As Integer
  'Read the number from the cell
  Number = Range("A1")
  'Split into chars
  ReDim Numbers(1 To Len(Number))
  For i = 1 To Len(Number)
    Numbers(i) = Mid$(Number, i, 1)
  Next
  'Build all combinations
  Set C = PermutationsTail(Numbers)
  Debug.Print C.Count
  'Convert into values and remove duplicates
  Set Dict = CreateObject("Scripting.Dictionary")
  For Each Item In C
    Value = CDbl(Join(Item, ""))
    If Not Dict.Exists(Value) Then Dict.Add Value, 0
  Next
  'Get the remaning values
  Data = Dict.Keys
  'Flush into the sheet
  With Range("C1")
    .EntireColumn.ClearContents
    .Resize(UBound(Data) + 1, 1).Value = WorksheetFunction.Transpose(Data)
  End With
End Sub

Function PermutationsTail(ByVal Arr) As Collection
  'Return all possible permutations in Arr as arrays in a collection
  'Based on a c++ algorithm by Phillip Paul Fuchs
  'Tail Permutations Using a Linear Array Without Recursion
  Dim i As Long, j As Long, ax As Long, N As Long
  Dim p() As Long, Temp
  Set PermutationsTail = New Collection
  'constant index ceiling (Arr[N] length)
  N = UBound(Arr) - LBound(Arr) + 1
  If N = 0 Then Exit Function
  ax = N - 1
  'target array and index control array
  ReDim p(0 To N)
  'p[N] > 0 controls iteration and the index boundary for i
  For i = 0 To N
    p(i) = i
  Next
  PermutationsTail.Add Arr
  'setup first swap points to be ax-1 and ax respectively (i & j)
  i = 1
  Do While i < N
    'decrease index "weight" for i by one
    p(i) = p(i) - 1
    'If i is odd then j = ax - p[i] otherwise j = ax
    j = ax - (i Mod 2) * p(i) + LBound(Arr)
    'adjust i to permute tail (i < j)
    i = ax - i + LBound(Arr)
    'set Scope
    Temp = Arr(j)
    Arr(j) = Arr(i)
    Arr(i) = Temp
    PermutationsTail.Add Arr
    'reset index i to 1 (assumed)
    i = 1
    Do While p(i) = 0
      'reset p[i] zero value
      p(i) = i
      'set new index value for i (increase by one)
      i = i + 1
    Loop
  Loop
End Function

Ru.PNG

Code Tags Added
Your post does not comply with Rule 2 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found at http://www.excelforum.com/forum-rule...rum-rules.html



(I have added them for you today. Please take a few minutes to read all Forum Rules and comply in the future.)