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.
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
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:
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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?
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,927
Members
448,533
Latest member
thietbibeboiwasaco

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top