# Fibonacci sequence help in VBA!!!

#### bglanton

##### New Member
1. Ask the user to enter a number.
2. Generate the Fibonacci sequence from 0 to that number.

### Excel Facts

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

#### NeonRedSharpie

##### Well-known Member
How do you want it to be generated? What do you expect it to look like?

#### bbott

##### Well-known Member
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
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 Number As Long

Number = InputBox("Enter a number")

x = 0
y = 0
z = 1

For i = 1 To 10
x = y
y = z
z = x + y
If z > Number Then
Exit Sub
End If
Next

End Sub``````

#### Rick Rothstein

##### MrExcel MVP

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
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

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
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
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
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.``````

Replies
1
Views
532
Replies
0
Views
15
Replies
6
Views
84
Replies
0
Views
29
Replies
3
Views
41