Help to convert formula into VBa code.

[VISHAL120]

Hi,

I needed help to program this formula into VBA code.


=IF($R35="",0,IF(BQ$33<$O35,0,IF(BQ$33>=$O35,MIN(($AA35-SUM($AF35:BP35)),$AB35,SUMIF(Shadow_km_Module,$R35,BQ$3:BQ$32)-SUMIF($R$34:$R34,$R35,BQ$34:BQ34),(MAX(OFFSET($AB$35,MATCH($V35,$V$35:$V$10 00,0)-1,0,MATCH($V35,$V$35:$V$1000,1)+1-MATCH($V35,$V$35:$V$1000,0),1)))-SUMIF($V$35:$V$1000,$V35,$AF$34:BP$1000)-SUMIF($V$34:$V34,$V35,BQ$34:BQ34)))))

This is because its taking around 25-30 secs for 1 change done on qty or dates as there are also many analysis and calculation which are done later after this calculation is over.

And also as you can see it limited to 1000 rows which is a very headache when the planning system is going beyond 10,000 rows for calculation. Sometimes its freezing or sometimes its stop working all all.

This is the main problem of that and also the time taken to do the calculation.

I have been trying several ways to do it but has not been able.

I really need guidance on that please.

Please find attached one sample file to have an idea of how it works.

I have remove some datas on that so that the become less in size.

[mdmackillop]

Sub FillFormula()
Dim rw As Long
Dim fmla As String
Application.Calculation = xlCalculationManual

fmla = "=IF(RC18="""",0,IF(R33C<RC15,0,IF(R33C>=RC15,MIN((RC27-SUM(RC32:RC[-1])),RC28,SUMIF(Shadow_km_Module,RC18,R3C:R32C)-SUMIF(R34C18:R[-1]C18,RC18,R34C:R[-1]C),(MAX(OFFSET(R35C28,MATCH(RC22,R35C22:R1000C22,0)-1,0,MATCH(RC22,R35C22:R1000C22,1)+1-MATCH(RC22,R35C22:R1000C22,0),1)))-SUMIF(R35C22:R1000C22,RC22,R34C32:R1000C[-1])-SUMIF(R34C22:R[-1]C22,RC22,R34C:R[-1]C)))))"

rw = Cells(Rows.Count, 2).End(xlUp).Row
Range("AG35:CH" & rw).FormulaR1C1 = fmla
Calculate
Range("AG35:CH" & rw).Value = Range("AG35:CH" & rw).Value
Application.Calculation = xlCalculationAutomatic

End Sub

[shrivallabha]

There was some discrepancy with respect to Absolute references which mdmackillop has removed in his VBA solution. So I ran md's code first to get the formula correct.

The method I use is:
1. Copy formula from Excel and paste it as it is.
2. Select the formula text and then perform find (") and replace ("") using quotes as listed in the bracket.
3. And then Wrap the entire formula in quotes.
It almost always works. See if it does here.

Formula adjustment credit: mdmackillop
Sub FillFormula2()
Dim lLR As Long
lLR = Cells(Rows.Count, 2).End(xlUp).Row
With Range("AG35:CH" & lLR)
.Formula = "=IF($R35="""",0,IF(AG$33<$O35,0,IF(AG$33>=$O35,MIN(($AA35-SUM($AF35:AF35)),$AB35,SUMIF(Shadow_km_Module,$R35,AG$3:AG$32)-SUMIF($R$34:$R34,$R35,AG$34:AG34),(MAX(OFFSET($AB$35,MATCH($V35,$V$35:$V$10 00,0)-1,0,MATCH($V35,$V$35:$V$1000,1)+1-MATCH($V35,$V$35:$V$1000,0),1)))-SUMIF($V$35:$V$1000,$V35,$AF$34:AF$1000)-SUMIF($V$34:$V34,$V35,AG$34:AG34)))))"
.Value = .Value
End With
End Sub

[VISHAL120]

Hi Both,

thanks for the quick reply.

the solution works well BUT it still limiting the calculation to 1000 rows on this part which is in bold:

MATCH($V35,$V$35:$V$1000,0)-1,0,MATCH($V35,$V$35:$V$1000,1)+1-MATCH($V35,$V$35:$V$1000,0),1)))-SUMIF($V$35:$V$1000,$V35,$AF$34:AF$1000)

the problem is actually the system goes beyond the 1000 rows which is the limiting factor today.

somtimes the data can go up to 2000 rows or 15,000 rows for calculation depending on the volume of orders and everytime my colleagues are coming to me for modification which is sometimes very risky when there is data that will be used to take decision and planning.

that is why i needed to convert the formula to purely VBA code.

there is this part of the formula which was help to me to convert to VBA by some of our collegues from VBA Express long before and which has solved many of our problems .

this is the part :


=IF($R35="",0,IF(AG$33<$O35,0,IF(AG$33>=$O35,MIN(($AA35-SUM($AF35:AF35)),$AB35,SUMIF(Shadow_km_Module,$R35,AG$3:AG$32)-SUMIF($R$34:$R34,$R35,AG$34:AG34))))

But at that time this part was not integrated:

(MAX(OFFSET($AB$35,MATCH($V35,$V$35:$V$1000,0)-1,0,MATCH($V35,$V$35:$V$1000,1)+1-MATCH($V35,$V$35:$V$1000,0),1)))-SUMIF($V$35:$V$1000,$V35,$AF$34:AF$1000)-SUMIF($V$34:$V34,$V35,AG$34:AG34)))))

here is the code for the first part you can see it working on the attachement also:
Sub formulation3()
starttime = Timer

'help from VBA express
Dim LR As Long
With ThisWorkbook.Sheets("Shadow_k_mins")
LR = .Range("B" & .Rows.Count).End(xlUp).Row
End With
Application.ScreenUpdating = False
blah3 Range("Shadow_Range_Formulation").Resize(LR - Range("Shadow_Range_Formulation").Row + 1)
Application.ScreenUpdating = True
'Application.DisplayAlerts = True
'Application.EnableEvents = True
Application.Cursor = xlDefault
'Debug.Print Timer - starttime & " - array"
'Debug.Print "xxxxxxxxxxxxxxxxx"
MsgBox Timer - starttime & " secs"
End Sub

Sub blah3(theRange As Range)
Dim myArray(), ControlDaysArray()
rowMax = theRange.Rows.Count
ColmMax = theRange.Columns.Count
ReDim myArray(1 To rowMax, 1 To ColmMax)
ReDim ControlDaysArray(1 To rowMax)
With ThisWorkbook.Sheets("shadow_k_mins")
'some row and column numbers from named ranges:
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
ModuleData = Application.Transpose(.Cells(theRange.Row, ModuleColmNo).Resize(rowMax))
For rw = 1 To rowMax
SheetRow = theRange.Rows(rw).Row
RowSumSoFar = 0
ControlDays = 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
If result > 0 Then ControlDays = ControlDays + 1
Else
myArray(rw, Colm) = 0
End If
End If
End If
Next Colm
ControlDaysArray(rw) = ControlDays
Next rw
End With
Range("Shadow_km_loading_zone").ClearContents
theRange = myArray
Range("Shadow_Control_Column").Resize(Range("Shadow_Control_Column").Rows.Count - 1).Offset(1).ClearContents
theRange.Offset(, Range("Shadow_Control_Column").Column - theRange.Column).Resize(, 1) = Application.Transpose(ControlDaysArray)
End Sub

Well i have been trying to incorporate the part : (MAX(OFFSET($AB$35,MATCH($V35,$V$35:$V$1000,0)-1,0,MATCH($V35,$V$35:$V$1000,1)+1-MATCH($V35,$V$35:$V$1000,0),1)))-SUMIF($V$35:$V$1000,$V35,$AF$34:AF$1000)-SUMIF($V$34:$V34,$V35,AG$34:AG34)))))

in the code but am still struggling with that.

if you can just guide me on here please this will be a great help for me and my colleagues who work with the system.

as many times i have modified the formula sometimes we have make serious mistakes and now after every anaylsis we are checking one by one in order to see that all all has been planned correctly.


thanks again for help in advance sir.

: pray2::help

[shrivallabha]

Maybe this:
Sub FillFormula2()
Dim lLR As Long
lLR = Cells(Rows.Count, "B").End(xlUp).Row
With Range("AG35:CH" & lLR)
.Formula = "=IF($R35="""",0,IF(AG$33<$O35,0,IF(AG$33>=$O35,MIN(($AA35-SUM($AF35:AF35)),$AB35,SUMIF(Shadow_km_Module,$R35,AG$3:AG$32)-SUMIF($R$34:$R34,$R35,AG$34:AG34),(MAX(OFFSET($AB$35,MATCH($V35,$V$35:$V$" & lLR & ",0)-1,0,MATCH($V35,$V$35:$V$" & lLR & ",1)+1-MATCH($V35,$V$35:$V$" & lLR & ",0),1)))-SUMIF($V$35:$V$" & lLR & ",$V35,$AF$34:AF$" & lLR & ")-SUMIF($V$34:$V34,$V35,AG$34:AG34)))))"
.Value = .Value
End With
End Sub

[VISHAL120]

its work fine but can you please guide if possible of how i can incorperate the formula in the above code please.

many thanks in advance.

[shrivallabha]

Looks to me p45cal was the helping person in the previous code.

Probably this should work out [Test it on a backup]:
Sub formulation3()
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
blah3 Range("Shadow_Range_Formulation").Resize(LR - Range("Shadow_Range_Formulation").Row + 1)

With ThisWorkbook.Sheets("Shadow_k_mins").Range("AG35:CH" & LR)
.Formula = "=IF($R35="""",0,IF(AG$33<$O35,0,IF(AG$33>=$O35,MIN(($AA35-SUM($AF35:AF35)),$AB35,SUMIF(Shadow_km_Module,$R35,AG$3:AG$32)-SUMIF($R$34:$R34,$R35,AG$34:AG34),(MAX(OFFSET($AB$35,MATCH($V35,$V$35:$V$" & LR & ",0)-1,0,MATCH($V35,$V$35:$V$" & LR & ",1)+1-MATCH($V35,$V$35:$V$" & LR & ",0),1)))-SUMIF($V$35:$V$" & LR & ",$V35,$AF$34:AF$" & LR & ")-SUMIF($V$34:$V34,$V35,AG$34:AG34)))))"
.Value = .Value
End With

Application.ScreenUpdating = True
Application.Cursor = xlDefault

MsgBox Timer - starttime & " secs"
End Sub

[VISHAL120]

Hi Shrivallabha,

you are its P45Cal who guide and explain to me the first solution. may be he is not free right now.

But many thanks your help also.

I just wanted to understand the logic of integrating the formula in the code that was help to me by P45Cal.

thanks again.

[shrivallabha]

Yes. There are few people who do the tough category coding and he's one of them.

To explain what I did. I looked at the code that p45cal had provided. There the Last Row was getting determined and then it would be used for processing the sub named "blah" ---> which is why I guessed his code :think:.

So I pasted the code in the first processing sub after finishing the main work by code "blah".