Link to home
Start Free TrialLog in
Avatar of Naresh Patel
Naresh PatelFlag for India

asked on

List VBA

I had this question after viewing Formula in Last 3 Columns.

Hi Experts,

i have one sheet called List which find unique dates and unique values with certain condition formula in Cells....i need to code put that formulas and get values and copy past special....most of are array formula ...i had recorded macro and it is working fine but it takes time to get values ....i need macro which copy down formula to the extent numeric values mention in row 5 for each column where formula applies.

Formulas For column A B C D E - G H I J K - M N O - Q R S are below (respectively )
=IFERROR(INDEX('Fresh Orders'!$B$2:$B$2000,MATCH(0,IF("VPL1"='Fresh Orders'!$L$2:$L$2000,COUNTIF($A$6:$A6,'Fresh Orders'!$B$2:$B$2000),""),0)),"")
=IFERROR(INDEX('Fresh Orders'!$G$2:$G$2000,MATCH(0,IF("VPL1"='Fresh Orders'!$L$2:$L$2000,COUNTIF($B$6:$B6,'Fresh Orders'!$G$2:$G$2000),""),0)),"")
=IF(B7="","",SUMIFS('Fresh Orders'!$F$2:$F$2000,'Fresh Orders'!$G$2:$G$2000,B7,'Fresh Orders'!$L$2:$L$2000,"VPL1"))
=IF(B7="","",SUMIFS('Fresh Orders'!$F$2:$F$2000,'Fresh Orders'!$G$2:$G$2000,B7,'Fresh Orders'!$L$2:$L$2000,"VPL1",'Fresh Orders'!$Z$2:$Z$2000,"Assigned"))
=IF(B7="","",SUMIFS('Fresh Orders'!$F$2:$F$2000,'Fresh Orders'!$G$2:$G$2000,B7,'Fresh Orders'!$L$2:$L$2000,"VPL1",'Fresh Orders'!$Z$2:$Z$2000,"Not Assigned"))




=IFERROR(INDEX('Fresh Orders'!$B$2:$B$2000,MATCH(0,IF("VPL2"='Fresh Orders'!$L$2:$L$2000,COUNTIF($G$6:$G6,'Fresh Orders'!$B$2:$B$2000),""),0)),"")
=IFERROR(INDEX('Fresh Orders'!$G$2:$G$2000,MATCH(0,IF("VPL2"='Fresh Orders'!$L$2:$L$2000,COUNTIF($H$6:$H6,'Fresh Orders'!$G$2:$G$2000),""),0)),"")
=IF(H7="","",SUMIFS('Fresh Orders'!$F$2:$F$2000,'Fresh Orders'!$G$2:$G$2000,H7,'Fresh Orders'!$L$2:$L$2000,"VPL2"))
=IF(H7="","",SUMIFS('Fresh Orders'!$F$2:$F$2000,'Fresh Orders'!$G$2:$G$2000,H7,'Fresh Orders'!$L$2:$L$2000,"VPL2",'Fresh Orders'!$Z$2:$Z$2000,"Assigned"))
=IF(H7="","",SUMIFS('Fresh Orders'!$F$2:$F$2000,'Fresh Orders'!$G$2:$G$2000,H7,'Fresh Orders'!$L$2:$L$2000,"VPL2",'Fresh Orders'!$Z$2:$Z$2000,"Not Assigned"))


=IFERROR(INDEX('Rework Oders'!$F$2:$F$499,MATCH(0,IF("VPL1"='Rework Oders'!$P$2:$P$499,COUNTIF($M$6:$M6,'Rework Oders'!$F$2:$F$499),""),0)),"")
=IFERROR(INDEX('Rework Oders'!$K$2:$K$499,MATCH(0,IF("VPL1"='Rework Oders'!$P$2:$P$499,COUNTIF($N$6:$N6,'Rework Oders'!$K$2:$K$499),""),0)),"")
=IF(N7="","",SUMIFS('Rework Oders'!$J$2:$J$499,'Rework Oders'!$K$2:$K$499,N7,'Rework Oders'!$P$2:$P$499,"VPL1"))


=IFERROR(INDEX('Rework Oders'!$F$2:$F$499,MATCH(0,IF("VPL2"='Rework Oders'!$P$2:$P$499,COUNTIF($Q$6:$Q6,'Rework Oders'!$F$2:$F$499),""),0)),"")
=IFERROR(INDEX('Rework Oders'!$K$2:$K$499,MATCH(0,IF("VPL2"='Rework Oders'!$P$2:$P$499,COUNTIF($R$6:$R6,'Rework Oders'!$K$2:$K$499),""),0)),"")
=IF(R7="","",SUMIFS('Rework Oders'!$J$2:$J$499,'Rework Oders'!$K$2:$K$499,R7,'Rework Oders'!$P$2:$P$499,"VPL2"))

Open in new window


Recorded Code is
Sub List()

    Range("A7").Select
    Selection.FormulaArray = _
        "=IFERROR(INDEX('Fresh Orders'!R2C2:R2000C2,MATCH(0,IF(""VPL1""='Fresh Orders'!R2C12:R2000C12,COUNTIF(R6C1:R[-1]C1,'Fresh Orders'!R2C2:R2000C2),""""),0)),"""")"
    Selection.AutoFill Destination:=Range("A7:A107"), Type:=xlFillDefault
    Range("A7:A107").Select
    Range("B7").Select
    Selection.FormulaArray = _
        "=IFERROR(INDEX('Fresh Orders'!R2C7:R2000C7,MATCH(0,IF(""VPL1""='Fresh Orders'!R2C12:R2000C12,COUNTIF(R6C2:R[-1]C2,'Fresh Orders'!R2C7:R2000C7),""""),0)),"""")"
    Selection.AutoFill Destination:=Range("B7:B107")
    Range("B7:B107").Select
    Range("C7").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]="""","""",SUMIFS('Fresh Orders'!R2C6:R2000C6,'Fresh Orders'!R2C7:R2000C7,RC[-1],'Fresh Orders'!R2C12:R2000C12,""VPL1""))"
    Selection.AutoFill Destination:=Range("C7:C107")
    Range("C7:C107").Select
    Range("D7").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-2]="""","""",SUMIFS('Fresh Orders'!R2C6:R2000C6,'Fresh Orders'!R2C7:R2000C7,RC[-2],'Fresh Orders'!R2C12:R2000C12,""VPL1"",'Fresh Orders'!R2C26:R2000C26,""Assigned""))"
    Selection.AutoFill Destination:=Range("D7:D107")
    Range("D7:D107").Select
    Range("E7").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-3]="""","""",SUMIFS('Fresh Orders'!R2C6:R2000C6,'Fresh Orders'!R2C7:R2000C7,RC[-3],'Fresh Orders'!R2C12:R2000C12,""VPL1"",'Fresh Orders'!R2C26:R2000C26,""Not Assigned""))"
    Selection.AutoFill Destination:=Range("E7:E107")
    Range("E7:E107").Select
    Range("A6:E107").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G7").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(INDEX('Fresh Orders'!R2C2:R2000C2,MATCH(0,IF(""VPL2""='Fresh Orders'!R2C12:R2000C12,COUNTIF(R6C7:R[-1]C7,'Fresh Orders'!R2C2:R2000C2),""""),0)),"""")"
    Selection.AutoFill Destination:=Range("G7:G107"), Type:=xlFillDefault
    Range("G7:G107").Select
    Range("H7").Select
    Selection.FormulaArray = _
        "=IFERROR(INDEX('Fresh Orders'!R2C7:R2000C7,MATCH(0,IF(""VPL2""='Fresh Orders'!R2C12:R2000C12,COUNTIF(R6C8:R[-1]C8,'Fresh Orders'!R2C7:R2000C7),""""),0)),"""")"
    Selection.AutoFill Destination:=Range("H7:H107")
    Range("H7:H107").Select
    Range("I7").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]="""","""",SUMIFS('Fresh Orders'!R2C6:R2000C6,'Fresh Orders'!R2C7:R2000C7,RC[-1],'Fresh Orders'!R2C12:R2000C12,""VPL2""))"
    Selection.AutoFill Destination:=Range("I7:I107")
    Range("I7:I107").Select
    Range("J7").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-2]="""","""",SUMIFS('Fresh Orders'!R2C6:R2000C6,'Fresh Orders'!R2C7:R2000C7,RC[-2],'Fresh Orders'!R2C12:R2000C12,""VPL2"",'Fresh Orders'!R2C26:R2000C26,""Assigned""))"
    Selection.AutoFill Destination:=Range("J7:J107")
    Range("J7:J107").Select
    Range("K7").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-3]="""","""",SUMIFS('Fresh Orders'!R2C6:R2000C6,'Fresh Orders'!R2C7:R2000C7,RC[-3],'Fresh Orders'!R2C12:R2000C12,""VPL2"",'Fresh Orders'!R2C26:R2000C26,""Not Assigned""))"
    Selection.AutoFill Destination:=Range("K7:K107")
    Range("K7:K107").Select
    Range("G6:K107").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("M7").Select
    Application.CutCopyMode = False
    Selection.FormulaArray = _
        "=IFERROR(INDEX('Rework Oders'!R2C6:R499C6,MATCH(0,IF(""VPL1""='Rework Oders'!R2C16:R499C16,COUNTIF(R6C13:R[-1]C13,'Rework Oders'!R2C6:R499C6),""""),0)),"""")"
    Selection.AutoFill Destination:=Range("M7:M107"), Type:=xlFillDefault
    Range("M7:M107").Select
    Range("N7").Select
    Selection.FormulaArray = _
        "=IFERROR(INDEX('Rework Oders'!R2C11:R499C11,MATCH(0,IF(""VPL1""='Rework Oders'!R2C16:R499C16,COUNTIF(R6C14:R[-1]C14,'Rework Oders'!R2C11:R499C11),""""),0)),"""")"
    Selection.AutoFill Destination:=Range("N7:N107")
    Range("N7:N107").Select
    Range("O7").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]="""","""",SUMIFS('Rework Oders'!R2C10:R499C10,'Rework Oders'!R2C11:R499C11,RC[-1],'Rework Oders'!R2C16:R499C16,""VPL1""))"
    Selection.AutoFill Destination:=Range("O7:O107")
    Range("O7:O107").Select
    Range("M6:O107").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Q7").Select
    Application.CutCopyMode = False
    Selection.FormulaArray = _
        "=IFERROR(INDEX('Rework Oders'!R2C6:R499C6,MATCH(0,IF(""VPL2""='Rework Oders'!R2C16:R499C16,COUNTIF(R6C17:R[-1]C17,'Rework Oders'!R2C6:R499C6),""""),0)),"""")"
    Selection.AutoFill Destination:=Range("Q7:Q107"), Type:=xlFillDefault
    Range("Q7:Q107").Select
    Range("R7").Select
    Selection.FormulaArray = _
        "=IFERROR(INDEX('Rework Oders'!R2C11:R499C11,MATCH(0,IF(""VPL2""='Rework Oders'!R2C16:R499C16,COUNTIF(R6C18:R[-1]C18,'Rework Oders'!R2C11:R499C11),""""),0)),"""")"
    Selection.AutoFill Destination:=Range("R7:R107")
    Range("R7:R107").Select
    Range("S7").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-1]="""","""",SUMIFS('Rework Oders'!R2C10:R499C10,'Rework Oders'!R2C11:R499C11,RC[-1],'Rework Oders'!R2C16:R499C16,""VPL2""))"
    Selection.AutoFill Destination:=Range("S7:S107")
    Range("S7:S107").Select
    Range("Q6:S107").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.ScrollColumn = 1
    Range("A6").Select
    Application.CutCopyMode = False
End Sub

Open in new window


Recorded code is extent to row 107 but for each column it dont needs to ....i need modification in macro which drill down formula to number of rows which is mention in row 5 for each column.

See attached

Thanks
WIP.xlsm
Avatar of Naresh Patel
Naresh Patel
Flag of India image

ASKER

In attached Sub List is in module 1
Avatar of Roy Cox
Why do you need to add the formulas using VBA? Using large numbers of Array Formulas can slow Excel's calculating speed.
as this formulas taking refference of other sheets where data is populated by VBA...so when i execute that VBA.....because of this formulas it slower the process ,,,and it is really slow ..

Thanks
You can switch off Calculation whilst running code

 
 Dim    lCalc as long
   lCalc = Application.Calculation

'' your code here"

Application.Calculation=   lCalc 

Open in new window

above code will switch off auto calc and switch on Auto calc on at the end?

if yes then i will do the same

Thanks
Sorry , I missed a line of code.

 Dim    lCalc as long
   lCalc = Application.Calculation

'' your code here"

Application.Calculation=   lCalcThe code first checks what the Calculation setting is

Open in new window


The code first determines the Calculation setting. Then switches it off whilst the macro runs.

Finally it restores the original setting
ASKER CERTIFIED SOLUTION
Avatar of Ejgil Hedegaard
Ejgil Hedegaard
Flag of Denmark image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Perfect