Solved: Code for vba to replace below formula

Hi all

I have been using a planning system which till now was working very well and also I was able to build the planning system with the help from vb express itself. Thanks a lot for the this help.
But the way it was working till now was very helpful with the formula and then I was using a vba code to copy paste the formula into values every time so that not to increase the size of the file.as this is a part of the planning system

The formula is as such IF($R19="",0,IF(F$33<$O19,0,IF(F$33>=$O19,IF(0<($AA19),MIN(($AA19-SUM(E19:$AF19)),$AB19,SUMIF(Shadow_km_Module,$R19,F$3:F$32)-SUMIF($R18:$R$34,$R19,F$34)),0))))

This formula is the heart for the planning system without this the planning is nothing as every time all analysis is done first with this and others can be done.
I have attached the file so that you can have a better idea of how it works..you can click on the button to see how it works to have an idea. Or just copy the formula from the parameter data and paste it on the shadow_k_mins where the calendar starts the calculation area is not formatted but when there is figures it will format through conditional formatting..

When the system is running there is lot of anaylsis which shall be generated at one go.

As you know every time that an order is not respecting the dates it shall be changed and the analysis shall be run again to have a better results and this has been done till now with 500-600 rows analysis at one go.

But now it will be working with almost 500 to 6000 rows almost 3 -4 times than the actual. And this will take a lot of time for the anaylsis. I have made a simulation with 2000 rows it has freeze and after almost 3 -4 mins that the anaylsis has been done and it very time consuming. All other parts has been program using vba. Its only this part that uses formula..

What I need is how I can program this through vba instead of using the formula. And this will be very beneficial for the planning system and also for the user.

From what I understand built in excel formulas are much faster and efficient then the vba we use. Vba would probably end up slowing you down not speeding you up.

Any quicker?
[VBA]Sub formulation()
Dim FMLA As String
Dim LR As Long

Application.ScreenUpdating = False
LR = Range("B" & Rows.Count).End(xlUp).Row

FMLA = "=IF(RC18="""",0,IF(R33C<RC15,0,IF(R33C>=RC15,IF(0<(RC27),MIN((RC27-SUM(RC[-1]:RC32)),RC28,SUMIF(Shadow_km_Module,RC18,R3C:R32C)-SUMIF(R34C18:R[-1]C18,RC18,R34C)),0))))"
With Range("$AG$35:CH" & LR)
.FormulaR1C1 = FMLA
.Value = .Value
End With

FMLA = "=COUNTIF(RC33:RC86,"">0"")"
With Cells(35, "AD").Resize(LR - 35)
.FormulaR1C1 = FMLA
.Value = .Value
End With

Application.ScreenUpdating = True

End Sub
[/VBA]

I've managed to cut down the time taken to about 1/5th, though I think I could do more since I concentrated on speeding up only the slowest part, that is the part which pastes and calculates the biggest range.
First, I tried mdmackillop's solutions but they had no significant speed advantage, then I tried removing and shortening your code a bit:
First I noticed that your formula seems a little longer than necessary and shortened it from:[vba]=IF($R35="",0,IF(N$33<$O35,0,IF(N$33>=$O35,IF(0<($AA35),MIN(($AA35-SUM(M35:$AF35)),$AB35,SUMIF(Shadow_km_Module,$R35,N$3:N$32)-SUMIF($R34:$R$34,$R35,N$34)),0))))
to:
=IF($R35="",0,IF(N$33<$O35,0,IF(0<($AA35),MIN(($AA35-SUM(M35:$AF35)),$AB35,SUMIF(Shadow_km_Module,$R35,N$3:N$32)-SUMIF($R34:$R$34,$R35,N$34)),0)))
[/vba]by taking out the:
If(N$33>=$O35,
since it has to be true as you've previously asked:
If(N$33<$O35
The shorter formula gives the same results throughout, tested on the data you supplied.

Second, I removed lines of code which assigned variables never used elsewhere, removed selecting ranges/cells and activating sheets, so now one of the sheets can remains hidden throughout.
Didn't make a sausage of a difference to the time though.:eek:

So this is what was left:
[vba]Sub formulation()
Dim LR As Long
With ThisWorkbook.Sheets("Shadow_k_mins")
LR = .Range("B" & .Rows.Count).End(xlUp).Row
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Range("Para_Formulation").Copy Range("Shadow_Range_Formulation").Resize(LR - Range("Shadow_Range_Formulation").Row + 1)
Application.Calculation = xlCalculationAutomatic
Range("Shadow_km_loading_zone").Value = Range("Shadow_km_loading_zone").Value
'>>> USE TO CALCULATE NUMBER OF DAYS LOADED TO DERIVE END DATES.
Control_Point_date_col = Range("Shade_Km_Control_point_end_date_Col").Column
Shade_Km_Pos_Col = Range("Shade_Km_Pos_Col").Column
Loading_Row_Start = Range("Shadow_Km_Header_row").Row + 1
'>>>> apply countif on the control point column
Range("Para_Countif_Formula").Copy .Range(.Cells(Loading_Row_Start, Shade_Km_Pos_Col), .Cells(Loading_Row_Start, Shade_Km_Pos_Col).End(xlDown)).Offset(, Control_Point_date_col - Shade_Km_Pos_Col)
End With
'>>> select the the control column bottom part as their is formula working on the module number
Range("Shadow_Control_Column").Value = Range("Shadow_Control_Column").Value
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Cursor = xlDefault
Application.ScreenUpdating = True
End Sub
[/vba] Perhaps you could try this on your larger data set and hopefully it won't freeze on you.

It was the lines in red above which were by far the slowest to execute.
So on to arrays, this has been a bit of a challenge; Since in the sheet, each formula relies on the results of similar formulae above and to the left of it (and one of those is a SumIf dependent on cells outside the grid). I tried Application.Index to slice the array to use with Sum and SumIf but this slowed it down enormusly (worse than just using the formuale in the sheet).

Anyway, after much testing I reached an in-memory array solution:
[vba]Sub formulation2()
Dim LR As Long
With ThisWorkbook.Sheets("Shadow_k_mins")
LR = .Range("B" & .Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False

blah Range("Shadow_Range_Formulation").Resize(LR - Range("Shadow_Range_Formulation").Row + 1)

'>>> USE TO CALCULATE NUMBER OF DAYS LOADED TO DERIVE END DATES.
Control_Point_date_col = Range("Shade_Km_Control_point_end_date_Col").Column
Shade_Km_Pos_Col = Range("Shade_Km_Pos_Col").Column
Loading_Row_Start = Range("Shadow_Km_Header_row").Row + 1
'>>>> apply countif on the control point column
Range("Para_Countif_Formula").Copy .Range(.Cells(Loading_Row_Start, Shade_Km_Pos_Col), .Cells(Loading_Row_Start, Shade_Km_Pos_Col).End(xlDown)).Offset(, Control_Point_date_col - Shade_Km_Pos_Col)
End With
'>>> select the the control column bottom part as their is formula working on the module number
Range("Shadow_Control_Column").Value = Range("Shadow_Control_Column").Value
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Cursor = xlDefault
Application.ScreenUpdating = True
End Sub

Sub blah(theRange As Range)
Dim myArray()
rowMax = theRange.Rows.Count
ColmMax = theRange.Columns.Count
ReDim myArray(1 To rowMax, 1 To ColmMax)
With ThisWorkbook.Sheets("shadow_k_mins")
'some row and column numbers from named ranges:
ShadowKmHeaderRowNo = Range("Shadow_Km_Header_row").Row '34
ShadeKmCapacityAreaStartRow = Range("Shade_km_Capacity_area").Row '3
ShadeKmCapacityAreaEndRow = Range("Shade_km_Capacity_area").Row + Range("Shade_km_Capacity_area").Rows.Count - 1 '32

ModuleColmNo = Range("Shade_Km_Module_Col").Column '18
TotalMinsColmNo = Range("Shade_KM_Total_Mins_Load_Cells_Col").Column '27
MinsProduceAsPerCapColmNo = Range("Shade_Km_Mins_Prod_As_Per_Cap_Col").Column '28
KshadowLoadingZoneMarkerStartColmNo = Range("Kshadow_Loading_Zone_Marker_Start_Column").Column '32
ModuleData = Application.Transpose(.Cells(theRange.Row, ModuleColmNo).Resize(rowMax))
For rw = 1 To rowMax
SheetRow = theRange.Rows(rw).Row
RowSumSoFar = 0
For Colm = 1 To ColmMax
SheetColm = theRange.Columns(Colm).Column
If Cells(SheetRow, ModuleColmNo) = "" Then
myArray(rw, Colm) = 0
Else
If Cells(33, SheetColm) < Cells(SheetRow, 15) Then
myArray(rw, Colm) = 0
Else
If 0 < Cells(SheetRow, TotalMinsColmNo) Then
'calculate 2nd sumif:
ThisModule = ModuleData(rw)
SecondSumif = 0
For i = 1 To rw - 1
If ModuleData(i) = ThisModule Then SecondSumif = SecondSumif + myArray(i, Colm)
Next i
Result = Application.Min((.Cells(SheetRow, TotalMinsColmNo) - RowSumSoFar), .Cells(SheetRow, MinsProduceAsPerCapColmNo), Application.SumIf(Range("Shadow_km_Module"), .Cells(SheetRow, ModuleColmNo), .Range(.Cells(ShadeKmCapacityAreaStartRow, SheetColm), .Cells(ShadeKmCapacityAreaEndRow, SheetColm))) - SecondSumif)
myArray(rw, Colm) = Result
RowSumSoFar = RowSumSoFar + Result
Else
myArray(rw, Colm) = 0
End If
End If
End If
Next Colm
Next rw
End With
theRange = myArray
End Sub
[/vba] The code relies partially on the named ranges you have put in place, so those names might require maintenance if you change things.
The attached file has all the above code, with an extra button added so a speed comparison can be made between the two.

If time is critical, the bit:
[vba]Range("Para_Countif_Formula").Copy .Range(.Cells(Loading_Row_Start, Shade_Km_Pos_Col), .Cells(Loading_Row_Start, Shade_Km_Pos_Col).End(xlDown)).Offset(, Control_Point_date_col - Shade_Km_Pos_Col)
End With
'>>> select the the control column bottom part as their is formula working on the module number
Range("Shadow_Control_Column").Value = Range("Shadow_Control_Column").Value
[/vba]could be converted to pure vba too, but I don't know how significant those time savings might be.
This was developed with Excel 2010 in compatibility mode.

hI ,

Many thanks for the help, i has been wondering since long on how this can be done and now i fully encourage to increase more its feature for the planning system. i will give it a try and revert back on same. however if there is more solution on how we can make it more linear and speedy thanks to propose.

Shaved off a little more time; the attached now has a third button which calls code in a new code module (module1) where the countif formula (control days column) calculations are incorporated into the sub which calculates the main range. This code also clears old data before writing to the sheet in case the pre-existing data was bigger (number of rows) than the current data, but this may not be necesary as the code which loads the data should do this.

I've left the other code module in there for speed test comparisons.

hi thanks a lot its working very well when integrated on the planning system and its not freezing.

by the way i have been going through the code and there is part which i don't understand on that can you please explain it to me so that i later use on other system .

the 1st part
ModuleData = Application.Transpose(.Cells(theRange.Row, ModuleColmNo).Resize(rowMax))

what this is actually doing before the calculation.

2nd part :
Else
If Cells(33, SheetColm) < Cells(SheetRow, 15) Then
myArray(rw, Colm) = 0

why cells(33, ) and cells( , 15 ) has been used.

as for others i have been able to figure out.
thanking you in advance for your help.

Quote:

---

Originally Posted by VISHAL120

…there is part which i don't understand on that can you please explain it to me so that i later use on other system .

ModuleData = Application.Transpose(.Cells(theRange.Row, ModuleColmNo).Resize(rowMax))

what this is actually doing before the calculation.

---

ModuleData is an array (in memory) of the values in R35:R419 of your sample file.
Taking the innermost parentheses first:
.Cells(theRange.Row, ModuleColmNo)
The cells property, when followed by numbers, represents a single cell:
cells(row no., column no.)
theRange.row is the top row of the range passed to the sub blah and is 35.
ModuleColmNo is 18, assigned earlier in the code.
So we have
cells(35,18), which is R35.
This range (single cell) is resized with .Resize(RowMax)
RowMax is 385, assigned earlier in the code.
The resize property, like the cells property, uses two numbers, rows and columns:
Resize(RowSize, ColumnSize)
In this case there's only one number, so it's the first one, RowSize.
So now the range is R35:R419
Finally, the Application.transpose bit; With it in place the line produces an array which looks like:
http://www.box.net/shared/u6tizvxn3r
which is a single dimension array, without the transpose, it would look like:
http://www.box.net/shared/zvvsk5r8mf
which is a two dimensional array (I've expanded 3 of the members) which is more difficult to work with than a single dimension array and contains no more information.

ModuleData is then used later, over and over again in the lines:
[vba] ThisModule = ModuleData(rw)
SecondSumif = 0
For i = 1 To rw - 1
If ModuleData(i) = ThisModule Then SecondSumif = SecondSumif + myArray(i, Colm)
Next i
[/vba] and is used to calculate the 2nd SumIf part of the formula, highlighted in blue below:
[vba]=IF($R35="",0,IF(N$33<$O35,0,IF(0<($AA35),MIN(($AA35-SUM(M35:$AF35)),$AB35,SUMIF(Shadow_km_Module,$R35,N$3:N$32)-SUMIF($R34:$R$34,$R35,N$34)),0)))[/vba]in the longest line of thesub which starts:
result = Application…
where the value is held in the variable SecondSumif.

Quote:

---

Originally Posted by VISHAL120

2nd part :
Else
If Cells(33, SheetColm) < Cells(SheetRow, 15) Then
myArray(rw, Colm) = 0

why cells(33, ) and cells( , 15 ) has been used.

---

As already mentioned above, the Cells property is followed by 2 numbers: row and column. So the 33 represents a row number, and the 15 represents a column number.

It's the vba equivalent of the red part in the formula below:
[vba]=IF($R35="",0,IF(N$33<$O35,0,IF(0<($AA35),MIN(($AA35-SUM(M35:$AF35)),$AB35,SUMIF(Shadow_km_Module,$R35,N$3:N$32)-SUMIF($R34:$R$34,$R35,N$34)),0)))[/vba]The 33 is prefixed with $ so it's an absolute reference (doesn't change), while column 15 (column O) is also prefixed with a $.

Hi ok i have understand the way you have program.

i have included another sheet on the data files2 where this one also i am using the formula sumif like this:
shadow_k_mins!AG2-SUMIF(shadow_k_mins!$R$35:$R$1544,shadow_k_mins!$AD2,shadow_k_mins!AG$35:AG $1544)
and after that i used vba to copy and paste as values. you can click on the button still to load minutes to see the calculation.

This one will calculate the still to plan minutes which later i used to convert to operators after the planning system has already plan the produce mins on the shadow_k_mins.

but still this one as you see will limit and will take times to run.

can you please help on that as i have been trying to used the same programming logic you used for the shadow_k_mins calculation but till now its not working.

many thanks for your help.

I'm going to be lazy and not go down the route of making all the calculations in-memory. The formula is much simpler than the last exercise and doesn't depend on other values in the same range, so there'll be no real speed advantage over the solutions below.

The first solution is the slowest completing 170 times faster than your routine:
[vba]Sub Still_To_Load_MIns1()
StartTime = Timer
'the following loop is necessary since .end and specialcells were not reliable as there is something in apparently blank cells:
Application.Calculation = xlCalculationManual
For Each cll In Range("Shadow_KS_Modules_col").Cells
If cll.Value = "" Then
Set KSModulesRng = Range(Range("Shadow_KS_Modules_col").Cells(1), cll.Offset(-1))
If KSModulesRng.Row < Range("Shadow_KS_Modules_col").Row Then
MsgBox "No modules"
Exit Sub
End If
Exit For
End If
Next cll
'KSModulesRng is now the range of modules in column AD
Range("Shadow_KS_Capacity_Area").ClearContents
With Intersect(Range("shadow_KS_Capacity_Area"), KSModulesRng.EntireRow)
.FormulaR1C1 = _
"=shadow_k_mins!RC[23]-SUMIF(shadow_k_mins!R35C18:R1544C18,shadow_k_mins!RC30,shadow_k_mins!R35C[23]:R1544C[23])"
Application.Calculation = xlCalculationAutomatic
.Value = .Value
End With
MsgBox Timer - StartTime & " secs."
End Sub
[/vba] The above is also the safest of the three in case there is something wrong/missing in AD3:AD32.

The second solution runs 220 times as fast as yours:
[vba]Sub Still_To_Load_MIns2()
StartTime = Timer
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Range("Shadow_KS_Capacity_Area").ClearContents
With Intersect(Range("shadow_KS_Capacity_Area"), Range("Shadow_KS_Modules_col").SpecialCells(xlCellTypeConstants, 19).EntireRow)
.FormulaR1C1 = "=shadow_k_mins!RC[23]-SUMIF(shadow_k_mins!R35C18:R1544C18,shadow_k_mins!RC30,shadow_k_mins!R35C[23]:R1544C[23])"
Application.Calculation = xlCalculationAutomatic
.Value = .Value
End With
Application.ScreenUpdating = True
MsgBox Timer - StartTime & " secs."
End Sub[/vba]
and the third solution 230 times as fast:
[vba]Sub Still_To_Load_MIns3()
StartTime = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set KSModulesRng = Range(Range("Shadow_KS_Modules_col").Cells(1), Range("Shadow_KS_Modules_col").Cells(1).End(xlDown))
'KSModulesRng is now the range of modules in column AD
Range("Shadow_KS_Capacity_Area").ClearContents
With Intersect(Range("shadow_KS_Capacity_Area"), KSModulesRng.EntireRow)
.FormulaR1C1 = "=shadow_k_mins!RC[23]-SUMIF(shadow_k_mins!R35C18:R1544C18,shadow_k_mins!RC30,shadow_k_mins!R35C[23]:R1544C[23])"
Application.Calculation = xlCalculationAutomatic
.Value = .Value
End With
Application.ScreenUpdating = True
MsgBox Timer - StartTime & " secs."
End Sub[/vba]
Even if the running times were 100 times faster than the above offerings by going in-memory, the absolute time saved for each run would be a fraction of a second. Not worth doing.

Hi ,
its work correctly and with a high speed. but the only problem with this is, it will be limited to 1544 rows as it was previously. As i mentioned a start the planning system can go up to 2000 rows or more depending on the number of order which need to be plan. so using it with the formula will still be a blockage for the system. that is why i wanted to code the calculation. thanks to see if you can guide me again on that.
many many thanks for your precious time and helpful hand.

Ahh yes, a fundamental ommission…
below additions/amendents to all three:
[vba]Sub Still_To_Load_MIns1()
StartTime = Timer
Dim LR As Long
With ThisWorkbook.Sheets("Shadow_k_mins")
LR = .Range("B" & .Rows.Count).End(xlUp).Row
End With
'the following loop is necessary since .end and specialcells were not reliable as there is something in apparently blank cells:
Application.Calculation = xlCalculationManual
For Each cll In Range("Shadow_KS_Modules_col").Cells
If cll.Value = "" Then
Set KSModulesRng = Range(Range("Shadow_KS_Modules_col").Cells(1), cll.Offset(-1))
If KSModulesRng.Row < Range("Shadow_KS_Modules_col").Row Then
MsgBox "No modules"
Exit Sub
End If
Exit For
End If
Next cll
'KSModulesRng is now the range of modules in column AD
Range("Shadow_KS_Capacity_Area").ClearContents
With Intersect(Range("shadow_KS_Capacity_Area"), KSModulesRng.EntireRow)
.FormulaR1C1 = "=shadow_k_mins!RC[23]-SUMIF(shadow_k_mins!R35C18:R" & LR & "C18,shadow_k_mins!RC30,shadow_k_mins!R35C[23]:R" & LR & "C[23])"
Application.Calculation = xlCalculationAutomatic
.Value = .Value
End With
MsgBox Timer - StartTime & " secs."
End Sub[/vba][vba]
Sub Still_To_Load_MIns2()
StartTime = Timer
Dim LR As Long
With ThisWorkbook.Sheets("Shadow_k_mins")
LR = .Range("B" & .Rows.Count).End(xlUp).Row
End With
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Range("Shadow_KS_Capacity_Area").ClearContents
With Intersect(Range("shadow_KS_Capacity_Area"), Range("Shadow_KS_Modules_col").SpecialCells(xlCellTypeConstants, 19).EntireRow)
.FormulaR1C1 = "=shadow_k_mins!RC[23]-SUMIF(shadow_k_mins!R35C18:R" & LR & "C18,shadow_k_mins!RC30,shadow_k_mins!R35C[23]:R" & LR & "C[23])"
Application.Calculation = xlCalculationAutomatic
.Value = .Value
End With
Application.ScreenUpdating = True
MsgBox Timer - StartTime & " secs."
End Sub[/vba][vba]
Sub Still_To_Load_MIns3()
StartTime = Timer
Dim LR As Long
With ThisWorkbook.Sheets("Shadow_k_mins")
LR = .Range("B" & .Rows.Count).End(xlUp).Row
End With
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set KSModulesRng = Range(Range("Shadow_KS_Modules_col").Cells(1), Range("Shadow_KS_Modules_col").Cells(1).End(xlDown))
'KSModulesRng is now the range of modules in column AD
Range("Shadow_KS_Capacity_Area").ClearContents
With Intersect(Range("shadow_KS_Capacity_Area"), KSModulesRng.EntireRow)
.FormulaR1C1 = "=shadow_k_mins!RC[23]-SUMIF(shadow_k_mins!R35C18:R" & LR & "C18,shadow_k_mins!RC30,shadow_k_mins!R35C[23]:R" & LR & "C[23])"
Application.Calculation = xlCalculationAutomatic
.Value = .Value
End With
Application.ScreenUpdating = True
MsgBox Timer - StartTime & " secs."
End Sub
[/vba]

hi boss,

thanks you very very much you have made my system very efficient with your help. i respect your precious time that you have given me and in helping my system to go faster than before. just for your info the system was running at 45-50 sec on every change and analysis and now its running at 15 secs on every change and analysis.

thanks again sir.

Hi ,

Can you please help me on this thread please as i am deliberately needing help on this even just a hint on how i can do it ro some reference. for that.

post : title : updating data from another workbook