Oh dios!!
Es verdad, va como un tiro!!
Las Collections son mas apropiadas cuando se trabaja con poca cantidad de Items...
Por eso acabo de hacer esta tercera versión, es la mas rápida de las mias, y de velocidad anda pareja con la de LeandroA  :

Option Explicit
Private Declare Sub RtlMoveMemory Lib "Kernel32" (ByVal Destination As Any, ByVal Source As Any, ByVal length As Long)
 
Public Function Check_Lucky_Number3(ByVal lNumber As Long) As Boolean
    Dim lTempArray()            As Long
    Dim NextElim                As Long
    Dim lArrayUBound            As Long
    Dim m                       As Long
    Dim x                       As Long
 
    If lNumber = 1 Or lNumber = 3 Then
        GoTo IsLucky
    ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then
        m = 1
        For x = 1 To lNumber Step 2
            ReDim Preserve lTempArray(m)
            lTempArray(m) = x
            m = m + 1
        Next
        NextElim = 3: m = 2
        Do
            x = NextElim
            Do While x <= UBound(lTempArray)
                lArrayUBound = UBound(lTempArray)
                If Not x = lArrayUBound Then
                    RtlMoveMemory VarPtr(lTempArray(x)), VarPtr(lTempArray(x + 1)), (lArrayUBound - x) * 4
                    ReDim Preserve lTempArray(lArrayUBound - 1)
                Else
                    Exit Function
                End If
                x = x + (NextElim - 1)
            Loop
            m = m + 1
            NextElim = lTempArray(m)
        Loop While Not NextElim > lArrayUBound
IsLucky: Check_Lucky_Number3 = True
    End If
End Function

Testeado con GetTickCount:

---

@Dessa
Me referia a que hicieses algo asi:

Option Explicit
 
Function IsLucky2(lngNum As Long) As Boolean
    Dim x As Long, cont As Long, contStep As Long, Indice As Long, numLuck() As String
 
    If lngNum < 1 Or lngNum Mod 2 = 0 Or lngNum = 5 Then Exit Function
    If lngNum = 1 Or lngNum = 3 Then IsLucky2 = True: Exit Function
 
    For x = 1 To lngNum Step 2
          ReDim Preserve numLuck(contStep)
          numLuck(contStep) = x
          contStep = contStep + 1
    Next
    contStep = 0: cont = 0: Indice = 1
    While numLuck(Indice) <= UBound(numLuck)
      For x = 0 To UBound(numLuck)
          If cont = numLuck(Indice) - 1 Then
            cont = 0
          Else
            numLuck(contStep) = numLuck(x)
            cont = cont + 1
            contStep = contStep + 1
          End If
      Next
      If contStep = numLuck(Indice + 1) Then ReDim Preserve numLuck(contStep - 2) Else ReDim Preserve numLuck(contStep - 1)
      If numLuck(UBound(numLuck)) <> lngNum Then Exit Function
      cont = 0
      contStep = 0
      Indice = Indice + 1
    Wend
 
    IsLucky2 = True
End Function

IsLucky : 147,75 ms
IsLucky2 : 87,45 ms

---

@Karcrack
Una duda con tu code:

If (lNumb And 1 = 0) Then Exit Function

Esto para que es?¿  
Es como hacer Mod?¿

---

DoEvents¡!

Hola a todos:

No pude evitar hacer un código después de ver el ímpetu que demuestran.

Hice un código que recibe un número y despliega un mensaje, informando si ese número es o no es de la suerte. El mensaje también muestra el tiempo transcurrido en realizar las operaciones; muestra el tiempo antes de iniciar las operaciones, el tiempo después de realizar las operaciones y por último, la diferencia entre ambos, es decir, el tiempo total empleado en realizar las operaciones.

Sólo lo probé con los números del 1 al 37, ya que me dió flojera probar con más números.

Pero bueno, se necesita un cuadro de texto Text1 y un botón de comando Command1. El código es el siguiente:


Option Explicit

Private Sub Command1_Click()
Dim esdesuerte As Boolean
Dim t1 As Long, t2 As Long, tdif As Long
    t1 = timeGetTime()
    esdesuerte = verifnum(Val(Text1.Text))
    t2 = timeGetTime()
    tdif = t2 - t1
    If esdesuerte = False Then
        MsgBox ("El número " & Val(Text1.Text) & " no es de la suerte" _
        & Chr(13) & "t1 = " & t1 & Chr(13) & "t2 = " & t2 & Chr(13) _
        & "Tiempo = " & tdif)
    Else
        MsgBox ("El número " & Val(Text1.Text) & " es de la suerte" _
        & Chr(13) & "t1 = " & t1 & Chr(13) & "t2 = " & t2 & Chr(13) _
        & "Tiempo = " & tdif)
    End If
End Sub

Private Function verifnum(ByVal num As Long) As Boolean
Dim bufA(33000) As Long
Dim bufB(33000) As Long
Dim indElim As Long
Dim iniciales As Long
Dim i As Long
Dim i_auxA As Long
Dim i_auxB As Long
   
    If num Mod 2 = 0 Then
        verifnum = False
        Exit Function
    End If
   
    indElim = 2
    iniciales = 1
    i = 1
    Do While iniciales <= num
        bufA(i) = iniciales
        iniciales = iniciales + 2
        i = i + 1
    Loop
    i = i - 1
   
    If indElim >= i Then
        verifnum = True
    Else
        Do
            indElim = bufA(indElim)
            If indElim > i Then
                verifnum = True
                Exit Function
            End If
            i_auxA = indElim
            While i_auxA <= i
                If bufA(i_auxA) = num Then
                    verifnum = False
                    Exit Function
                End If
                bufA(i_auxA) = bufA(i_auxA) * -1
                i_auxA = i_auxA + indElim
            Wend
       
            i_auxA = 1
            i_auxB = 1
            While i_auxA <= i
                If bufA(i_auxA) > 0 Then
                    bufB(i_auxB) = bufA(i_auxA)
                    i_auxB = i_auxB + 1
                End If
                i_auxA = i_auxA + 1
            Wend
            i = i_auxB - 1
       
            indElim = bufB(indElim)
            If indElim > i Then
                verifnum = True
                Exit Function
            End If
            i_auxB = indElim
            While i_auxB <= i
                If bufB(i_auxB) = num Then
                    verifnum = False
                    Exit Function
                End If
                bufB(i_auxB) = bufB(i_auxB) * -1
                i_auxB = i_auxB + indElim
            Wend
           
            i_auxA = 1
            i_auxB = 1
            While i_auxB <= i
                If bufB(i_auxB) > 0 Then
                    bufA(i_auxA) = bufB(i_auxB)
                    i_auxA = i_auxA + 1
                End If
                i_auxB = i_auxB + 1
            Wend
            i = i_auxA - 1
        Loop
    End If
End Function


Y en el módulo el código es el siguiente:


Option Explicit

Public Declare Function timeGetTime Lib "winmm.dll" () As Long

En fín, si alguien quiere hacerme el favor de revisarlo  para números arriba del 37 se los agradeceré. Es que es demasiado fastidioso estar generando a mano los números de la suerte.

                    Saludos

Si Pyske1   , te entendí pero probé 45235 (compilado), con gettickcount y las dos van parejas... por supuesto que tendría que ser mas rapida con tu sugerencia (sin el último For). intentaré mejorar con RtlMoveMemory  




Tokes, el 45 lo da como true y no lo es, tambien entre 1 y 200 hay 8 numeros mas que no son Lucky, saludos







    

Bueno, he hecho una pequeña correción en el código y queda así. Me parece que ahora si da los números bien y es un poquitín más rápido.

Se necesitan 2 command buttons (Command1 y Command2) y textbox Text1 y una label Label1. El Command1 dice si el número del Text1 es de la suerte. El command2 da los números de la suerte desde el 1 hasta el especificado en Text1.

La Label1 debe ser un tantito grande para que le quepan todos los números.
La función que verifica si el número es de la suerte se llama verifnum.


Y el código del módulo es:


Bueno, el código es un poco largo pero me parece que va un poquitín más rápido.

No se si es una forma chapucera de hacerlo pero asi de una forma rapido fue k se me ocurrio con arrays se k ess mas facil con los collection pero esa es la norma con los arrays pense k con un par de arrays anidados se podia como hice algo en la escuela una vez pero no tenia vastante tiempo haci k esta es la forma mas facil k pude hacerlo pork no tengo destrezas con usar datos en memoria jeje

Public Function LuckyNumber(ByVal N As Long) As Boolean
        Dim ANumero()    As Long
        Dim AText1()       As Long
        Dim i                   As Integer
        Dim X                  As Integer        
 
        i = 1
        X = 1
        If N Mod 2 = 0 Then Exit Function  
 
        For i = 1 To N Step 2
           ANumero(X) = i
           X = X + 1
        Next
        For i = 0 To UBound(ANumero) Step 3
            If ANumero(i) = N Then Exit Function
            ANumero(i) = 0
        Next
        X = 1
        For i = 1 To UBound(ANumero)
             If ANumero(i) <> 0 Then
                AText1(X) = ANumero(i)
                X = X + 1
             End If
        Next
        For i = 0 To UBound(AText1) Step 7
            If AText1(i) = N Then Exit Function            
        Next
 
        LuckyNumber = True
 
End Function

No se si es muy rapida pero funciona bien