Fibonacci sequence help in VBA!!!

bglanton

New Member
Joined
Oct 3, 2014
Messages
10
  1. Ask the user to enter a number.
  2. Generate the Fibonacci sequence from 0 to that number.
 

Some videos you may like

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

bbott

Well-known Member
Joined
Feb 5, 2010
Messages
2,350
Try this on a blank sheet. It will generate the sequence in column B.

Code:
Sub fib()

    Dim x As Long
    
    x = InputBox("Enter a number.")
    Range("B1") = 0
    Range("B2") = 1
    
    Do
        If Range("B" & Range("B" & Rows.Count).End(xlUp).Row).Value + _
        Range("B" & Range("B" & Rows.Count).End(xlUp).Row).Offset(-1, 0).Value >= x _
        Then Exit Sub
        Range("B" & Range("B" & Rows.Count).End(xlUp).Row).Offset(1, 0).FormulaR1C1 = _
        "=R[-1]C+R[-2]C"
    Loop
    
End Sub
 
Last edited:

NeonRedSharpie

Well-known Member
Joined
Jul 14, 2014
Messages
1,678
Here is a function that will return the nth fib number.

Code:
Function Fib(n As Long) As Long    
    Dim first As Long
    Dim second As Long
    Dim sum As Long
    Dim i As Long
    
    first = 0
    second = 1
    sum = 0
    
    If n = 0 Then
        Fib = first
    ElseIf n = 1 Then
        Fib = second
    Else
        For i = 2 To n
            sum = first + second
            first = second
            second = sum
        Next i
        Fib = sum
    End If
    
End Function

Here is vba that will return it comma delimeted in A1.

Code:
Sub fibinach()


Dim i As Integer
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim answer As String
Dim Number As Long


Number = InputBox("Enter a number")


x = 0
y = 0
z = 1


    For i = 1 To 10
        answer = answer & z & ", "
        x = y
        y = z
        z = x + y
        If z > Number Then
            answer = Left(answer, Len(answer) - 2)
            Cells(1, 1) = answer
            Exit Sub
        End If
    Next


End Sub
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,307
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Below is an "infinite" precision function that I developed and posted back in 2002 to a VB newsgroup which prints the Nth Fibonacci number to as many digits as a string can hold. (Be aware, this routine slows down as the inputted number gets larger)...

Code:
Function FN(ByVal N As Integer) As String
   Dim X As Long, Z As Long, Carry As Long, PositionSum As Long
   Dim N_minus_0 As String, N_minus_1 As String, N_minus_2 As String
   If N = 1 Or N = 2 Then
     FN = 1
   Else
     N_minus_1 = "1"
     N_minus_2 = "1"
     For X = 3 To N
       Carry = 0
       N_minus_0 = Space$(Len(N_minus_1))
       If Len(N_minus_1) > Len(N_minus_2) Then N_minus_2 = "0" & N_minus_2
       For Z = Len(N_minus_1) To 1 Step -1
         PositionSum = Val(Mid$(N_minus_1, Z, 1)) + Val(Mid$(N_minus_2, Z, 1)) + Carry
         Mid$(N_minus_0, Z, 1) = Right$(CStr(PositionSum), 1)
         Carry = IIf(PositionSum < 10, 0, 1)
       Next
       If Carry Then N_minus_0 = "1" & N_minus_0
       N_minus_2 = N_minus_1
       N_minus_1 = N_minus_0
     Next
     FN = N_minus_0
   End If
 End Function
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,307
Office Version
  1. 2010
Platform
  1. Windows
Below is an "infinite" precision function that I developed and posted back in 2002 to a VB newsgroup which prints the Nth Fibonacci number to as many digits as a string can hold. (Be aware, this routine slows down as the inputted number gets larger)...

Code:
Function FN(ByVal N As Integer) As String
   Dim X As Long, Z As Long, Carry As Long, PositionSum As Long
   Dim N_minus_0 As String, N_minus_1 As String, N_minus_2 As String
   If N = 1 Or N = 2 Then
     FN = 1
   Else
     N_minus_1 = "1"
     N_minus_2 = "1"
     For X = 3 To N
       Carry = 0
       N_minus_0 = Space$(Len(N_minus_1))
       If Len(N_minus_1) > Len(N_minus_2) Then N_minus_2 = "0" & N_minus_2
       For Z = Len(N_minus_1) To 1 Step -1
         PositionSum = Val(Mid$(N_minus_1, Z, 1)) + Val(Mid$(N_minus_2, Z, 1)) + Carry
         Mid$(N_minus_0, Z, 1) = Right$(CStr(PositionSum), 1)
         Carry = IIf(PositionSum < 10, 0, 1)
       Next
       If Carry Then N_minus_0 = "1" & N_minus_0
       N_minus_2 = N_minus_1
       N_minus_1 = N_minus_0
     Next
     FN = N_minus_0
   End If
 End Function
As I said earlier, this was old code... I changed some variables that were declared as Integers to Long, but I see I missed changing the argument to the function... that should be changed to Long as well.
Code:
Function FN(ByVal N As Long) As String
    Dim X As Long, Z As Long, Carry As Long, PositionSum As Long
    Dim N_minus_0 As String, N_minus_1 As String, N_minus_2 As String
    If N = 1 Or N = 2 Then
      FN = 1
    Else
     N_minus_1 = "1"
      N_minus_2 = "1"
      For X = 3 To N
        Carry = 0
        N_minus_0 = Space$(Len(N_minus_1))
        If Len(N_minus_1) > Len(N_minus_2) Then N_minus_2 = "0" & N_minus_2
        For Z = Len(N_minus_1) To 1 Step -1
          PositionSum = Val(Mid$(N_minus_1, Z, 1)) + Val(Mid$(N_minus_2, Z, 1)) + Carry
          Mid$(N_minus_0, Z, 1) = Right$(CStr(PositionSum), 1)
          Carry = IIf(PositionSum < 10, 0, 1)
        Next
        If Carry Then N_minus_0 = "1" & N_minus_0
        N_minus_2 = N_minus_1
        N_minus_1 = N_minus_0
      Next
      FN = N_minus_0
    End If
  End Function
I also forgot to mention that the function can be used as a UDF (user defined function) in a worksheet formula as well as being able to be called from other VB code). I guess I should note, because of the size of the numbers that can be returned by the function, the function outputs a text string value, not a real number.
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,307
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

I just re-read the original message and see that the OP was not looking for a function like I posted in Message #6, so here is that code recast to a subroutine that asks the user to input the value whose Fibonacci number he/she wants to calculate. Just to reiterate, though, the function slows down quite a bit as the Fibonacci number being calculated increases; for example, I have a fairly fast computer and it took 7.8 seconds for it to calculate the 2090 digits for the number 9999; so, consider this note a word to the wise.
Code:
Sub Fibonacci()
  Dim X As Long, Z As Long, N As Long, Carry As Long, PositionSum As Long
  Dim N_minus_0 As String, N_minus_1 As String, N_minus_2 As String
  N = Format(Application.InputBox("Please enter which Fibonacci Number you want to calculate...", Type:=1), "0")
  If N = 1 Or N = 2 Then
    MsgBox 1
  ElseIf N > 2 Then
    N_minus_1 = "1"
    N_minus_2 = "1"
    For X = 3 To N
      Carry = 0
      N_minus_0 = Space$(Len(N_minus_1))
      If Len(N_minus_1) > Len(N_minus_2) Then N_minus_2 = "0" & N_minus_2
      For Z = Len(N_minus_1) To 1 Step -1
        PositionSum = Val(Mid$(N_minus_1, Z, 1)) + Val(Mid$(N_minus_2, Z, 1)) + Carry
        Mid$(N_minus_0, Z, 1) = Right$(CStr(PositionSum), 1)
        Carry = IIf(PositionSum < 10, 0, 1)
      Next
      If Carry Then N_minus_0 = "1" & N_minus_0
      N_minus_2 = N_minus_1
      N_minus_1 = N_minus_0
    Next
    MsgBox N_minus_0
  Else
    MsgBox "The number you enter must be greater than zero!"
  End If
End Sub
 

bglanton

New Member
Joined
Oct 3, 2014
Messages
10
Here is a function that will return the nth fib number.

Code:
Function Fib(n As Long) As Long    
    Dim first As Long
    Dim second As Long
    Dim sum As Long
    Dim i As Long
    
    first = 0
    second = 1
    sum = 0
    
    If n = 0 Then
        Fib = first
    ElseIf n = 1 Then
        Fib = second
    Else
        For i = 2 To n
            sum = first + second
            first = second
            second = sum
        Next i
        Fib = sum
    End If
    
End Function

End Sub[/CODE]

this is very helpful, but is there a way to display the entire sequence up to the n?
 

NeonRedSharpie

Well-known Member
Joined
Jul 14, 2014
Messages
1,678
this is very helpful, but is there a way to display the entire sequence up to the n?
Code:
Function Fib(n As Long) As Variant    
    Dim first As Long
    Dim second As Long
    Dim sum As Long
    Dim i As Long
    
    first = 0
    second = 1
    sum = 0
    
    If n = 0 Then
        Fib = first
    ElseIf n = 1 Then
        Fib = second
    Else
        For i = 2 To n
            sum = first + second
            first = second
            second = sum
            Fib = Fib & "," & sum
        Next i
        Fib = Right(Fib, Len(Fib) - 1)
    End If
    
End Function
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,307
Office Version
  1. 2010
Platform
  1. Windows
Just to reiterate, though, the function slows down quite a bit as the Fibonacci number being calculated increases; for example, I have a fairly fast computer and it took 7.8 seconds for it to calculate the 2090 digits for the number 9999; so, consider this note a word to the wise.
Code:
[/QUOTE]
For those who might be interested, it took my code 12.6 minutes to calculate the 20,899 digits for the Fibonacci Number 99999 on my relatively fast computer. I will note, by the way, for comparison purposes, that NeonRedSharpie's code seems to be limited to calculating a maximum Fibonacci Number of 46.
 

Watch MrExcel Video

Forum statistics

Threads
1,108,805
Messages
5,524,979
Members
409,613
Latest member
Dalex100

This Week's Hot Topics

Top