Vba code is running too slow
hi. I am trying to solve non linear equations using Gauss siedel itterations. Somehow, the code taking too long to run. please advise . attached is my following code
Option Explicit
Sub crossisedel()
Dim y(0 To 10, 1 To 2) As Variant
Dim x(0 To 10, 1 To 2) As Variant
Dim Q(0 To 10, 1 To 2) As Variant
Dim ff(10), fp(10), pr(10), P(2), pf(10), counter, im1, retentate(10), fr(10), theta, pp(10), i, j As Double
Dim alpha, area, currentcell, areaperstage, nostages, nocomponents, errmax, maxItteration, Err1, Err2, Err3 As Long
currentcell = 5
area = 1000
areaperstage = 100
nostages = 10
nocomponents = 2
P(1) = 0.00001
P(2) = 0.000001
ff(0) = 100
pf(0) = 760
pp(10) = 76
x(0, 1) = 0.21
x(0, 2) = 0.79
errmax = 0.0001
maxItteration = 100
alpha = 0.1
'flowfeed=ff
'pressurefeed=pf
'flowretentate=fr
'pressureretentate=pr
'flowpermeate=fp
'pressurepermeate=pp
For i = 1 To 10
For j = 1 To 2
im1 = i - 1
fr(im1) = 100
pf(0) = 76
'Permeation flow at each stages
Q(i, j) = area * (P(j) * x(im1, j) - alpha * y(i, j))
'Feed compostion at each stages
x(i, j) = (fr(im1) * x(im1, j) - Q(i, j) / (fr(im1) - Q(i, j)))
'calculate the theta
theta = Q(i, j) / ff(0)
'Permeate composition at each stages
y(i, j) = ((P(j) * pf(0) * x(im1, j) / theta) / (Q(i, j) + pp(10) * P(j) + P(j) * pf(0) * (1 - theta) / theta))
Next j
Next i
ReDim x_new(1 To 10, 1 To 2), y_new(1 To 10, 1 To 2), Q_new(0 To 10, 1 To 2) As Long
counter = 0 ' counter to handle indifinite loop
For i = 1 To 10
For j = 1 To 2
Err1 = 1
Err2 = 1
Err3 = 1
Q(i, j) = 0
x(i, j) = 0
y(i, j) = 0
errmax = 0.000001
Do Until ((Err1 < errmax) And (Err2 < errmax) And (Err3 < errmax))
'Estimate permeate flow composition
Q_new(i, j) = area * (P(j) * x(i - 1, j) - alpha * y(i, j))
'Estimate feed composition
x_new(i, j) = (fr(im1) * x(im1, j) - Q_new(i, j)) / (fr(im1) - Q_new(i, j))
'Estimate permeate compostion
y_new(i, j) = ((P(j) * pf(0) * x(im1, j) / theta) / (Q_new(i, j) + pp(i) * P(j) + P(j) * pf(0) * (1 - theta) / theta))
'Estimate error
Err1 = Abs((Q_new(i, j) - Q(i, j) / (Q(i, j) + 0.001)))
Err2 = Abs((x_new(i, j) - x(i, j) / (x(i, j) + 0.001)))
Err3 = Abs((y_new(i, j) - y(i, j) / (y(i, j) + 0.001)))
Q(i, j) = Q_new(i, j)
x(i, j) = x_new(i, j)
y(i, j) = y_new(i, j)
counter = counter + 1
If (counter > maxItteration) Then
Sheet2.Range("b10").Value = "diverges"
End If
Loop
Sheets("sheet2").Range("b" & i + currentcell).Value = Q(i, 1)
Sheets("sheet2").Range("c" & i + currentcell).Value = Q(i, 2)
Sheets("sheet2").Range("c" & i + currentcell).Value = x(i, 1)
Sheets("sheet2").Range("d" & i + currentcell).Value = x(i, 2)
Sheets("sheet2").Range("e" & i + currentcell).Value = y(i, 1)
Sheets("sheet2").Range("f" & i + currentcell).Value = y(i, 2)
Next j
Next i
End Sub
Couple of things you can try
Couple of things you can try :-
Put this before the loop
Application.screenupdating = false
Application.Calculation = xlManual
Don't forget to reset it at the end
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic