0

I have a macro executing formulas that are entered into cells, then applied to roughly 70,000 cells. The process takes more than 24 hours (it's still running). I need to find a way to speed up the process. My first thought is to populate the cells with the results of the formula instead of the formula itself, but I'm at a lost.

Currently, the macro scans three different worksheets to determine how many unique values there are. Then the formulas are applied for each unique value. Below is my code for one of the worksheets where the formulas are applied. I have some test code commented out that limited the rows to 40, but when I run all unique rows for this sample I have 56,136. For 40 rows, this still takes about 5 minutes.

'return to Summary and throw in formulas for each unique alarm per type
Range("A1").Select
Sheets("AlarmHistory-Summary").Select

Dim RowHeader As Long
Dim RowFirst As Long
Dim RowSecond As Long
Dim aUnqRowFirst As Long
Dim aUnqRowLast As Long
Dim dUnqRowFirst As Long
Dim dUnqRowLast As Long
Dim oUnqRowFirst As Long
Dim oUnqRowLast As Long

RowHeader = 1
RowFirst = 2
RowSecond = 3
dUnqRowFirst = RowFirst
dUnqRowLast = dUnqRowFirst + dCountUnique
aUnqRowFirst = dUnqRowLast + 1
aUnqRowLast = aUnqRowFirst + aCountUnique
oUnqRowFirst = aUnqRowLast + 1
oUnqRowLast = oUnqRowFirst + oCountUnique

Const ReturnType1 As String = "RETURN"

'Digital Point formulas
Range(dUnqRowFirst).Select

Set dSVA = Range("A" & dUnqRowFirst & ":A" & dUnqRowLast)
Set dSVB = Range("B" & dUnqRowFirst & ":B" & dUnqRowLast)
Set dSVC = Range("C" & dUnqRowFirst & ":C" & dUnqRowLast)
Set dSVD = Range("D" & dUnqRowFirst & ":D" & dUnqRowLast)
Set dSVE = Range("E" & dUnqRowFirst & ":E" & dUnqRowLast)
Set dSVF = Range("F" & dUnqRowFirst & ":F" & dUnqRowLast)
'Set dSVG = Range("G" & dUnqRowFirst & ":G" & dUnqRowLast)
Set dSVH = Range("H" & dUnqRowFirst & ":H" & dUnqRowLast)
'Set dSVA = Range("A" & dUnqRowFirst & ":A40")
'Set dSVB = Range("B" & dUnqRowFirst & ":B40")
'Set dSVC = Range("C" & dUnqRowFirst & ":C40")
'Set dSVD = Range("D" & dUnqRowFirst & ":D40")
'Set dSVE = Range("E" & dUnqRowFirst & ":E40")
'Set dSVF = Range("F" & dUnqRowFirst & ":F40")
'Set dSVG = Range("G" & dUnqRowFirst & ":G40")
'Set dSVH = Range("H" & dUnqRowFirst & ":H40")


dSVA.Formula = "=IFERROR(LOOKUP(2,1/(COUNTIF($A$" & RowHeader & ":A" & RowHeader & ",'AlarmHistory-Digital'!$D$" & dRowFirst & ":$D$" & dRowLast & ")=0),'AlarmHistory-Digital'!$D$" & dRowFirst & ":$D$" & dRowLast & "),"""")"
dSVB.Formula = "=IFERROR(LOOKUP(2,1/(COUNTIF($A$" & RowHeader & ":A" & RowHeader & ",'AlarmHistory-Digital'!$D$" & dRowFirst & ":$D$" & dRowLast & ")=0),'AlarmHistory-Digital'!$E$" & dRowFirst & ":$E$" & dRowLast & "),"""")"
dSVC.Formula = "=IF($A" & RowFirst & "="""","""",IFERROR(AVERAGEIFS('AlarmHistory-Digital'!$O:$O,'AlarmHistory-Digital'!$D:$D,$A" & RowFirst & ",'AlarmHistory-Digital'!$B:$B,""" & ReturnType1 & """),0))"
dSVD.Formula = "=IF($A" & RowFirst & "="""","""",IFERROR(MINIFS('AlarmHistory-Digital'!$O:$O,'AlarmHistory-Digital'!$D:$D,$A" & RowFirst & ",'AlarmHistory-Digital'!$B:$B,""" & ReturnType1 & """),0))"
dSVE.Formula = "=IF($A" & RowFirst & "="""","""",IFERROR(MAXIFS('AlarmHistory-Digital'!$O:$O,'AlarmHistory-Digital'!$D:$D,$A" & RowFirst & ",'AlarmHistory-Digital'!$B:$B,""" & ReturnType1 & """),0))"
dSVF.Formula = "=IF($A" & RowFirst & "="""","""",IFERROR(COUNTIFS('AlarmHistory-Digital'!$D:$D,$A" & RowFirst & ",'AlarmHistory-Digital'!$B:$B,""" & ReturnType1 & """),0))"
Range("G" & dUnqRowFirst).FormulaArray = "=IFERROR(LARGE(IF('AlarmHistory-Digital'!$D$" & dRowFirst & ":$D$" & dRowLast & "=$A" & RowFirst & ",'AlarmHistory-Digital'!$O$" & dRowFirst & ":$O$" & dRowLast & "),F" & RowFirst & "-ROUNDUP($F" & RowFirst & "*0.8,0)+1),"""")"
Range("G" & dUnqRowFirst).AutoFill Range("G" & dUnqRowFirst & ":G" & dUnqRowLast)
dSVH.Formula = "=COUNTIFS('AlarmHistory-Digital'!D:D,A" & RowFirst & ",'AlarmHistory-Digital'!O:O,""<""&G" & RowFirst & ")"

Range(aUnqRowFirst).Select
MsgBox "Digital Calculations Applied"
BigBen
  • 46,229
  • 7
  • 24
  • 40
Benjamin Poskie
  • 1
  • First thing: [avoid using select in your code](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba), qualify your ranges instead. [This](https://stackoverflow.com/questions/22104743/excel-vba-autofill-multiple-cells-with-formulas) may prove useful. – cybernetic.nomad Jan 08 '20 at 20:32
  • What is a unique row? It would take me a a second or two to go through 80,000 numbers detecting duplicates using a dictionary object. –  Jan 08 '20 at 20:45
  • You definitely need to disable application.screenupdating as well as set the application.calculation to xlCalculationManual. Avoid using Select. These are basic tips on greatly improving macro efficiency. – SnowGroomer Jan 08 '20 at 21:23
  • finding unique values is going through a list of 100,000 items and idenifying the unique entries based upon an identifier. Below is some more code for identifying the unique rows – Benjamin Poskie Jan 08 '20 at 21:48
  • Application.Volatile On Error Resume Next Dim dCellValue As Variant Dim dCountUnique As Long Dim dUniqueValues As New Collection Dim dUniqueValues As New Collection Dim dCountUnique As Long ListRange = Range("$A$" & dRowFirst & ":$A$" & dRowLast) For Each dCellValue In ListRange dUniqueValues.Add dCellValue, CStr(dCellValue) 'add the unique item Next dCountUnique = dUniqueValues.Count - 1 'subtract 1 for header row – Benjamin Poskie Jan 08 '20 at 21:48
  • i'm don't know specifically how to qualify ranges instead of using 'select' – Benjamin Poskie Jan 08 '20 at 21:50
  • i found the thread about not using select in the code, i've also applied the screenupdating function and xlCalculationManual – Benjamin Poskie Jan 08 '20 at 21:57

1 Answers1

0

You can use advance filter, where A1:H1 are heading:

Range("Sheet1!A1:H1000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
    "Sheet2!A1:H1"), Unique:=True
user11982798
  • 1,878
  • 1
  • 6
  • 8