Excecl VBA Classic Excel VBA 2010 Excel VBA 365 Excel VBA Examples About Us

Geometric Progression


This is an Excel VBA program that generates a geometric progression(Also called geometric series or geometric sequence) and displays the results in a range of cells.

Geometric progression is a sequence of numbers where each subsequent number is found by multiplying the previous number by a fixed number. The fixed number is called the common ratio. The common ratio can be negative, an integer, a fraction and any number but it must not be a zero.

The formula to find the nth term of the geometric progression is arn-1

, where a is the first number and r is the common ratio.

In Excel VBA, we employs the Do.... Loop Until statement to generate the geometric progression.

In this program, we insert two command buttons, one is to generate the geometric sequence and the other one is to clear contents. We need to clear contents because we intend to display the GP in a table with border on the worksheet.

The formula to add border with a certain color is :

 Set Rng = Range(start_cell, end_cell)

    With Rng.Borders
        .LineStyle = xlContinuous
        .Color = vbBlue
        .Weight = xlThick  'Think border. Use xlThin if you want a thin border
    End With
	

The formula to clear contents is :

Range(Cells(start_cell, end_cell).ClearContents
Range(Cells(start_cell, end_cell).ClearFormats
 

The Complete Code

Private Sub Cmd_Generate_Click()
Dim n, num As Integer
Dim a, x, r As Single
a = Cells(3, 3)
r = Cells(4, 3)
num = Cells(5, 3)

n = 1
Do
x = a * r ^ (n - 1)
Cells(n + 5, 2) = "Term " & n


Cells(n + 5, 3) = x
n = n + 1

Loop Until n = num + 1

Set Rng = Range(Cells(6, 2), Cells(n + 4, 3))

    With Rng.Borders
        .LineStyle = xlContinuous
        .Color = vbBlue
        .Weight = xlThick
    End With
End Sub

Private Sub Cmd_Clear_Click()
Range(Cells(6, 2), Cells(1000, 3)).ClearContents
Range(Cells(6, 2), Cells(1000, 3)).ClearFormats
End Sub
The UI





Copyright ® 2008 Dr.Liew Voon Kiong . All rights reserved   [Privacy Policy]

Contact: Facebook Page