VBA: Slow solver-loop - excel
I have a code that in a simplified way calculates blast furnace gases for 168 hours (eg a week)
It reads in some input values and chemical values and calculated the molar masses in the system. After that the solver calculates in what chemical form (mainly CO, CO2) the gases exit in.
The problem is that it's extremely slow. If I have this excel workbook open it takes minutes and I haven't even bothered to let it run to the end when there are more workbooks open.
I'm very new to VBA, but I'd expect it to be a bit faster if I could set it to solve the equations in VBA instead of letting the values "iterate" back and forth between the excel worksheet and the VBA solver, by gradually solving the cell values - if I just knew how, IF it is possible or a good idea.
The code in its entity, first the general calculations:
Sub BFgas()
Datamatrix = Range(Cells.Find("Datamatrix").Offset(1, 0).Address, Cells.Find("Datamatrix").Offset(21, 0).Address)
ReDim BFoutput(1 To 168, 1 To 3) As Double
M_pigiron_Matrix = Range(Cells.Find("BF1 Pig iron production").Offset(1, 0).Address, Cells.Find("BF1 Pig iron production").Offset(168 + 1, 0).Address)
Bf_blast_Matrix = Range(Cells.Find("BF 1 - Blast").Offset(1, 0).Address, Cells.Find("BF 1 - Blast").Offset(168 + 1, 0).Address)
Bf_oxygen_Matrix = Range(Cells.Find("BF 1 - Oxygen").Offset(1, 0).Address, Cells.Find("BF 1 - Oxygen").Offset(168 + 1, 0).Address)
M = 1
Do
M_pigiron = M_pigiron_Matrix(M, 1) 'Tons of pig iron
Bf_blast = Bf_blast_Matrix(M, 1) 'Nm3
Bf_oxygen = Bf_oxygen_Matrix(M, 1) 'Nm3
If Bf_blast = 0 Or Bf_oxygen = 0 Then
Do
M_pigiron = M_pigiron_Matrix(M, 1) 'Tons of pig iron
Bf_blast = Bf_blast_Matrix(M, 1) 'Nm3
Bf_oxygen = Bf_oxygen_Matrix(M, 1) 'Nm3
M = M + 1
Loop While Bf_oxygen = 0 Or Bf_blast = 0
End If
n_N2_blast = Bf_blast * Datamatrix(19, 1) / Datamatrix(17, 1) 'kmol
n_O2_blast = Bf_blast * Datamatrix(18, 1) / Datamatrix(17, 1) 'kmol
n_O2_oxygenintake = Bf_oxygen / Datamatrix(17, 1) 'kmol
n_total_O_in = (n_O2_blast + n_O2_oxygenintake) * 2 'kmol
'Calculates the amounts of coke, briquettes and scrap
Cokeratio = Cells.Find("Input data").Offset(1, 1).Value2
Briqratio = Cells.Find("Input data").Offset(2, 1).Value2
Scrapratio = Cells.Find("Input data").Offset(3, 1).Value2
m_oil = Cells.Find("Input data").Offset(4, 1).Value2
m_coke = Cokeratio * M_pigiron * 1000 'kg
m_briq = Briqratio * M_pigiron 'kg
m_scrap = Scrapratio * M_pigiron 'kg
'Fe/Iron calculations
'Calculates the molar masses of iron and coal in pig iron, briqettes and scrap
n_Fe_pigiron = Datamatrix(3, 1) * M_pigiron * 1000 / Datamatrix(15, 1) 'kmol
n_Fe_briq = Datamatrix(12, 1) * m_briq / Datamatrix(15, 1) 'kmol
n_Fe_scrap = Datamatrix(13, 1) * m_scrap / Datamatrix(15, 1) 'kmol
'Calculates how many kmol is needed from pellets
n_Fe_pellets = n_Fe_pigiron - n_Fe_briq - n_Fe_scrap
m_pellets = n_Fe_pellets / Datamatrix(11, 1) * Datamatrix(15, 1) 'Divides by the iron content 0.72, to get the total mass
'O/Oxygen calculations
'Calculates the total incoming oxygen
'(m_pel*x_pellets,O + m_briq*x_O,briq)/M_O + n_blast,O2*2 + n_Oxygen,O2*2
Oxygen_in = m_pellets * Datamatrix(10, 1) / Datamatrix(16, 1) + m_briq * Datamatrix(9, 1) / Datamatrix(16, 1) + n_total_O_in 'kmol
Cells.Find("Solutions").Offset(0, 1).Value = Oxygen_in
'C/Coal calculations
'Calculates the incoming coal minus what comes out with the pig iron, leaving what comes out with the bf-gases
'm_coke,*x_C,coke + m_oil*x_C,oil + m_br*x_br,C = m_rj*x_C,rj + V_tg*(y,co + y,co2)
Coal_for_bf_gas = (m_coke * Datamatrix(4, 1) / Datamatrix(14, 1) + m_oil * Datamatrix(5, 1) / Datamatrix(14, 1) + m_briq * Datamatrix(6, 1) / Datamatrix(14, 1)) - M_pigiron * 1000 * Datamatrix(1, 1) / Datamatrix(14, 1)
Cells.Find("Solutions").Offset(0, 2).Value = Coal_for_bf_gas
'N/Nitrogen
'Nitrogen is mainly what comes in with the blast
N2_for_bf_gas = n_N2_blast
Cells.Find("Solutions").Offset(0, 3).Value = N2_for_bf_gas
'Sets in the hydrogen just in case
'H/hydrogen
'H_for_bf_gas = m_coke * Datamatrix(21, 1) / Datamatrix(20, 1) + m_oil * Datamatrix(7, 1) / Datamatrix(20, 1)
The solver part:
SolverReset 'Code solves the problem for a specific set of lines, in this case meaning hours
SolverOptions Precision:=1, Iterations:=100, AssumeNonNeg:=True
SolverOk setCell:=Cells.Find("Differences").Offset(1, 0).Address, MaxMinVal:=3, ValueOf:="0", ByChange:=Range(Cells.Find("Testing here").Offset(0, 1).Address, Cells.Find("Testing here").Offset(0, 3).Address)
SolverAdd cellRef:=Range(Cells.Find("Testing here").Offset(0, 2).Address, Cells.Find("Testing here").Offset(0, 3).Address), _
relation:=3, _
formulaText:=0.1
SolverAdd cellRef:=Range(Cells.Find("Testing here").Offset(0, 2).Address, Cells.Find("Testing here").Offset(0, 3).Address), _
relation:=1, _
formulaText:=0.4
SolverAdd cellRef:=Cells.Find("Testing here").Offset(0, 1).Address, _
relation:=3, _
formulaText:=(Bf_blast + Bf_oxygen) * 1.2
SolverAdd cellRef:=Cells.Find("Testing here").Offset(0, 1).Address, _
relation:=1, _
formulaText:=(Bf_blast + Bf_oxygen) * 2
SolverSolve userFinish:=True
BFoutput(M, 1) = Cells.Find("Testing here").Offset(0, 1).Value
BFoutput(M, 2) = Cells.Find("Testing here").Offset(0, 2).Value
BFoutput(M, 3) = Cells.Find("Testing here").Offset(0, 3).Value
M = M + 1
Loop While M < 169
Cells.Find("BF1 - Output data").Offset(2, 0).Resize(UBound(BFoutput, 1), 3).Value = BFoutput
I'm not a chemical engineer, so I don't know the equations you're trying to solve.
I'm guessing that they're non-linear, transient, and iterative. 168*3 = 504 degrees of freedom doesn't seem that large to me, but it could be a lot of work if you have lots of small time steps with iterations for each one.
I can't tell if you're doing a transient or steady state problem from the code you posted.
The numerical problems that I'm more familiar with (solid mechanics and heat transfer) are very sensitive to algorithm. The equations can be subject to time step restrictions for stability reasons, depending on the integration scheme chosen.
If you're solving a non-linear steady state problem the same comments would apply, except for iteration step size instead of time step size.
I can't glean much about this from your VB code, but I'll offer these recommendations:
Write out your equations, do a Fourier transform, and see if there are any stability restrictions.
Think about a tool kit like Matlab. They've got out of the box implementations that might be more highly optimized than your custom code.
I'm not aware of any profiling capabilities for VB or Excel, but you can't fix a problem without data. I'd see if I could get some information about where the time is being spent before hypothesizing about a solution.
Related
Inserting simply SUM in a cell formula results in Run-time error 1004
While trying to set some data from one spreadsheet to another in the same excel file it gives a Run-time error 1004: Application-defined or object-defined error. By debugging the code stops to work below when I'm trying to assign to that cell s.
Worksheets("Lista Sc").Select
With Sheets("Lista Sc")
.Range(Cells(riga, 3), Cells(riga + n, 3)).MergeCells = True
.Range(Cells(riga, 5), Cells(riga + n, 5)).MergeCells = True
.Range(Cells(riga, 21), Cells(riga + n, 21)).MergeCells = True
s = "=SOMMA(S" + CStr(riga) + ";T" + CStr(riga + 1) + ":T" + CStr(riga + n) + ")-L" + CStr(riga)
.Cells(riga, 21).FormulaLocal = s
It's the first time I'm trying to face problems with excel macro, so I have no idea on what's going on.
I suggest you use English with the Formula property, which will work regardless of the user's language settings: .Cells(riga, 21).Formula = "=SUM(S" + CStr(riga) + ",T" + CStr(riga + 1) + ":T" + CStr(riga + n) + ")-L" + CStr(riga)
VBA convert time on Number
I need to convert my time to Number. i need it because letter i'm going to divide this dates by yourself to calculate % (agent productive time ). I tried something like this 'cells(2,3) = 22:12:2 cells(2,3) / (60*60*1000) Thanks in advance
You can do like this:
a = "78:19:41"
b = "74:23:58"
ta = (Split(a, ":")(0) / 24) + TimeValue("00:" & Split(a, ":", 2)(1))
tb = (Split(b, ":")(0) / 24) + TimeValue("00:" & Split(b, ":", 2)(1))
p = tb / ta * 100
p -> 94.9844138434859
Excel VBA function terminates after first loop of for/next loop without finishing function
I just wrote this code to perform an iterative calculation. It finds the X,Y coordinates where an unknown parabola is tangent to a known circle. It is based on other iterative functions I've written that have worked flawlessly. I'm stumped as to what the issue is. Here is the code: Public Function Jext(PA As Double, Xcl As Double, Ycl As Double, Ctr As Double, Rnl As Double, Finl As Double) As Double Pi = 3.14159265358979 tol = 0.00000001 Dim x(20) As Double Dim Yc(20) As Double Dim Yp(20) As Double Dim A(20) As Double Dim Diff(20) As Double Dim It As Integer Dim hF As Double Dim Sf As Double 'Xcl is the horizontal position of the root radius center line 'Ycl is the vertical position of the root radius center line 'Ctr is root radius. It's an approximation of the trochoid and is typically the cutter tip radius 'Rnl is the radius to the point where the load line intersects the tooth centerline. It is the apex of the parabola 'x is the horizontal position that is common to the parabola and circle. It is the independent variable 'Yc is the vertical position on the circle at point x 'Yp is the vertical position on the parabola at point x 'A is the leading term of the parabolic equation 'Diff is the calculated difference in vertical positions of circle and parabola 'Set initial guess values. x(0) is 5% of the radius (left edge of circle) and x(1) is 95% of the radius(bottom of the circle) x(0) = (Xcl - Ctr) + 0.05 * Ctr x(1) = (Xcl - Ctr) + 0.95 * Ctr Yc(0) = Ycl - (Ctr ^ 2 - (x(0) - Xcl) ^ 2) ^ 0.5 Yc(1) = Ycl - (Ctr ^ 2 - (x(1) - Xcl) ^ 2) ^ 0.5 A(0) = Tan(WorksheetFunction.Acos((Xcl - x(0)) / Ctr) + Pi / 2) / (2 * x(0)) A(1) = Tan(WorksheetFunction.Acos((Xcl - x(1)) / Ctr) + Pi / 2) / (2 * x(1)) Yp(0) = A(0) * x(0) ^ 2 + Rnl Yp(1) = A(1) * x(1) ^ 2 + Rnl Diff(0) = Yp(0) - Yc(0) Diff(1) = Yp(1) - Yc(1) For It = 1 To 19 Step 1 x(It + 1) = x(It) - (Diff(It) - 0) * (x(It - 1) - x(It)) / (Diff(It - 1) - Diff(It)) Yc(It + 1) = Ycl - (Ctr ^ 2 - (x(It + 1) - Xcl) ^ 2) ^ 0.5 A(It + 1) = Tan(WorksheetFunction.Acos((Xcl - x(It + 1)) / Ctr) + Pi / 2) / (2 * x(It + 1)) Yp(It + 1) = A(It + 1) * x(It + 1) ^ 2 + Rnl Diff(It + 1) = Yp(It + 1) - Yc(It + 1) If Abs(Diff(It + 1)) < tol Then Exit For Debug.Print Diff(It + 1) Next It hF = Rnl - Yp(t + 1) Sf = 2 * x(t + 1) Jext = 1 / (Cos(Finl) / Cos(PA) * (6 * hF / Sf ^ 2 - Tan(Finl) / Sf)) End Function I put a stop at the "Next It" line to check the values as it went through the iterative loops. When I execute the code, all of the values are as expected and the value of Abs(Diff(It+1)) is not small enough to exit the for loop in the IF statement. I put the Debug.Print statement in there to make sure it was getting that far in the code and it did print Diff(It+1). So it executes everything to that point. Then when I continue the function it just stops and returns a #VALUE error in the spreadsheet. I've no idea why it won't continue the for loop. Anyone see something I've missed?
Step gives error sound but not description
I am trying to run some code on Visual basic and about an hour ago it was working fine. I did something(not sure what) and now it gives an error sound but no description. This only happens when I try to create my own function in a module. I have tried turning my pc on then off. I have opened different excel spreadsheets and yet it still won't let me run my function even with steps. My code below is incomplete but I'm sure it isn't the code itself thats the problem. Function onetube(Thi As Double, Tho As Double, Tci As Double, Tco As Double) As Double Dim phih, phic, phicf As Double Dim ai(1 To 4, 1 To 4) As Variant phih = (Thi - Tho) / (Thi - Tci) phic = (Tco - Tci) / (Thi - Tci) phicf = (phih - phic) / Application.WorksheetFunction.Ln((1 - phic) / (1 - phih)) ai(1, 1) = -0.462 ai(1, 2) = -0.0313 ai(1, 3) = -0.174 ai(1, 4) = -0.042 ai(2, 1) = 5.08 ai(2, 2) = 0.529 ai(2, 3) = 1.32 ai(2, 4) = 0.347 ai(3, 1) = -15.7 ai(3, 2) = -2.37 ai(3, 3) = -2.93 ai(3, 4) = -0.853 ai(4, 1) = 17.2 ai(4, 2) = 3.18 ai(4, 3) = 1.99 ai(4, 4) = 0.649 onetube = phicf End Function
Absolute Value of the Differences In Two (2) Ranges - PART II
Hopefully this is easier to read than yesterday. Trying to find a way to vary the number of periods "N" that measure "VOLATILITY" The code for the complete function as suggested yesterday is below and fixes "N" at 10. Function works just fine for KAMA with the default value for "N" (N0Addr and N1Addr are not needed in this default version of the KAMA function but are steps to get to a variable "N")
This formula works in Excel:
=SUMPRODUCT((ABS(I26:I36-I25:I35)))
I can also obtain the correct sum of differences in the two ranges but not the absolute value. This VBA Code does that with the named ranges "N0Addr" and "N1Addr":
Rng0 = WorksheetFunction.Sum(Range(N0Addr)) - WorksheetFunction.Sum(Range(N1Addr))
Function nTEST(Price, nPer, mPer, N)
'Variables
Fast = 2 / (nPer + 1)
Slow = 2 / (mPer + 1)
'One(1) Prior Period Calculation
nTEST1 = Application.Caller.Offset(-1)
N0Addr = Application.WorksheetFunction.Concat(Price.Offset(-N, 0).Address & ":" & Price.Address)
N1Addr = Application.WorksheetFunction.Concat(Price.Offset(-(N + 1), 0).Address & ":" & (Price.Offset(-1, 0).Address))
'Change Formula (Y - Yn)
E = Abs(Price - Price.Offset(-N, 0))
'Volatility Formula { =SUM(ABS(Y:Yn)-(Y1:Yn1))) }
'VOLATILITY (N = 10)
'1-10
R = Abs(Price - Price.Offset(-1, 0)) + Abs(Price.Offset(-1, 0) - Price.Offset(-2, 0)) _
+ Abs(Price.Offset(-2, 0) - Price.Offset(-3, 0)) _
+ Abs(Price.Offset(-3, 0) - Price.Offset(-4, 0)) + Abs(Price.Offset(-4, 0) - Price.Offset(-5, 0)) _
+ Abs(Price.Offset(-5, 0) - Price.Offset(-6, 0)) + Abs(Price.Offset(-6, 0) - Price.Offset(-7, 0)) _
+ Abs(Price.Offset(-7, 0) - Price.Offset(-8, 0)) + Abs(Price.Offset(-8, 0) - Price.Offset(-9, 0)) _
+ Abs(Price.Offset(-9, 0) - Price.Offset(-10, 0))
'EFFICIENCY RATIO
ER = E / R
Smooth = (ER * (Fast - Slow) + Slow) ^ 2
'Formula Calculation
nKAMA = Smooth * Price + (1 - Smooth) * nKAMA1
End Function
Looking for an VBA formula or method to input a working formula for "volatility" that can vary over N periods. I can get the sum of differences but not the sum of absolute differences.
Rng0 = WorksheetFunction.Sum(Range(N0Addr)) - WorksheetFunction.Sum(Range(N1Addr))
I can also enter one formula in Excel that accomplishes provides the sum of absolute differences.
=SUMPRODUCT((ABS(I26:I36-I25:I35)))