CODEWITHSUNDEEP
vbaexcel
Josh Readfern-Grey
Josh Readfern-Grey

Reputation: 33

This Excel VBA Macro is too Slow

Is there a way to speed up this code. I am very new to VBA (only really started this week) and I've made an attempt at writing this macro to automatically calculate the amount of money required to be borrowed based on a financial model.

To give some context, this cell informs a peak borrowing requirement (pbr) cell on another worksheet but when you increase the value of the facility required (fr) the pbr completely due to interest and various other charges on the amount being borrowed.

I've created a series of while loops to get this fr value to the closest 10,000 but is is INCREDIBLY slow. I'm sure there must be a more elegant way to write this but I cant seem to be able to figure it out. Preferably I would like to turn this into a function rather than a sub but I'm not even sure if that is possible.

Here is the code so far, any help you could give would be really appreciated!

' Sub procedure to calculate the peak borrowing requirement'

Sub calculateFacilityRequiredButton()
Dim pbr As Long ' stores the initial peak borrowing requirement from the viability page
Dim fr As Long ' stores the facility required from the inputs page

' set pbr variable as the value from the viability page 
Worksheets("Viability").Activate
pbr = Cells(9, "k").Value

' set the starting value at the current peak borrowing rate from the viability page

Worksheets("Viability").Activate
fr = Cells(9, "K").Value

Do While fr <= pbr
If fr <= pbr Then

fr = fr + 1000000
Worksheets("Inputs").Activate
Range("N47").Value = fr

Worksheets("Viability").Activate
pbr = Cells(9, "k").Value

End If

Loop


Do While fr > pbr + 100000
If fr > pbr + 100000 Then

fr = fr - 100000
Worksheets("Inputs").Activate
Range("N47").Value = fr

Worksheets("Viability").Activate
pbr = Cells(9, "k").Value



End If

Loop

Do While fr > pbr + 10000
If fr > pbr + 10000 Then

fr = fr - 10000
Worksheets("Inputs").Activate
Range("N47").Value = fr

Worksheets("Viability").Activate
pbr = Cells(9, "k").Value



End If

Loop

Worksheets("Inputs").Activate

End Sub

Upvotes: 2

Views: 884

Answers (3)

Josh Readfern-Grey
Josh Readfern-Grey

Reputation: 33

For reference in case anyone has a similar, comparable problem. Here is the solution that worked for me based on Zac's answer.

Sub CalculateFR()
' Sub procedure to calculate the peak borrowing requirement'

Dim pbr As Long ' stores the initial peak borrowing requirement from the viability page
Dim fr As Long ' stores the facility required from the inputs page
Dim oWV As Worksheet
Dim oWI As Worksheet

Set oWV = Sheets("Viability")
Set oWI = Sheets("Inputs")


' set pbr variable as the value from the viability page

pbr = oWV.Range("K9").Value

' set the starting value at the current peak borrowing rate from the viability page

fr = oWV.Range("K9").Value


Do While fr <= pbr

fr = fr + 1000000
oWI.Range("N47").Value = fr

pbr = oWV.Range("K9").Value

Loop

Do While fr <= pbr + 100000

fr = fr + 100000
oWI.Range("N47").Value = fr

pbr = oWV.Range("K9").Value

Loop

Do While fr <= pbr + 10000

fr = fr + 10000
oWI.Range("N47").Value = fr

pbr = oWV.Range("K9").Value

Loop

End Sub

Upvotes: 0

Zac
Zac

Reputation: 1944

Your While loop seem to have the same condition as your if condition. From what I can see, it will only ever perform one loop in your While loop. So I don't think you need the while loops. Also, as others have mentioned, don't try activating the sheets. Qualify your sheet as:

Dim oW As Worksheet: Set oW = ThisWorkbook.Worksheets("Viability")

You can then use it as oW.Range("N47").Value = fr. This should point you in the right direction

Upvotes: 0

Nathan_Sav
Nathan_Sav

Reputation: 8531

Try not to keep activating, do things like this

worksheets("Destination").range("A1").value=worksheets("Source").range("a1").value

Reference the worksheets, rather than activate them.

Upvotes: 2

Related Questions