Private Function IsLuckyNumber(ByVal Num As Long) As Boolean
 
    Dim lCount As Long, lPos As Long
    Dim c As New Collection
 
    If Num < 1 Then Exit Function
    If Num Mod 2 = 0 Then Exit Function
 
    For lPos = 1 To Num Step 2
        c.Add lPos
    Next
 
    lCount = 1
 
    Do While c.Count > lCount
 
        lCount = lCount + 1
        lPos = c(lCount)
 
        Do
            If lPos > c.Count Then Exit Do
            c.Remove lPos
            lPos = lPos + c(lCount) - 1
        Loop
 
        If c(c.Count) <> Num Then Exit Function
    Loop
 
    IsLuckyNumber = True
 
End Function
 

Private Sub Form_Load()
    Dim i As Long
    Dim s As String
    For i = 1 To 200
        If IsLuckyNumber(i) Then
            s = s & i & " "
        End If
    Next
    Debug.Print s
End Sub

Option Explicit
 
Public Function Check_Lucky_Number(ByVal lNumber As Long) As Boolean
    Dim cTemp                   As New Collection
    Dim NextElim                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
        With cTemp
            For x = 1 To lNumber Step 2
                .Add x
            Next
            NextElim = 3 : m = 2
            Do
                x = NextElim
                Do While x <= .Count
                    .Remove (x)
                    x = x + (NextElim - 1)
                Loop
                If .Item(.Count) = lNumber Then
                    m = m + 1
                    NextElim = .Item(m)
                Else
                    Exit Function
                End If
            Loop While Not NextElim > .Count
        End With
IsLucky: Check_Lucky_Number = True
    End If
End Function

Option Explicit
Public Function Check_Lucky_Number2(ByVal lNumber As Long) As Boolean
    Dim lTempArray()            As Long
    Dim NextElim                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)
                Call Delete_Array_Item(lTempArray, x)
                x = x + (NextElim - 1)
            Loop
            If lTempArray(UBound(lTempArray)) = lNumber Then
                m = m + 1
                NextElim = lTempArray(m)
            Else
                Exit Function
            End If
        Loop While Not NextElim > UBound(lTempArray)
IsLucky: Check_Lucky_Number2 = True
    End If
End Function
' Esto lo hace MUY lento... :( Mirar sig version en la pág siguiente ;)
Private Sub Delete_Array_Item(ByRef lArray() As Long, ByVal lIndex As Long)
    Dim lCount      As Long
    Dim x           As Long
 
    lCount = UBound(lArray)
    If lIndex <= lCount And lIndex >= LBound(lArray) Then
        For x = lIndex To lCount - 1
            lArray(x) = lArray(x + 1)
        Next
        ReDim Preserve lArray(lCount - 1)
    End If
End Sub

Private Sub Form_Load()
    Dim x           As Long
    Dim sResult     As String
 
    For x = 1 To 200
        'If Check_Lucky_Number2(x) Then
        If Check_Lucky_Number(x) Then
            sResult = sResult & x & " "
        End If
    Next
    Debug.Print sResult
End Sub