简体   繁体   中英

Excel VBA SUMIF Super slow code

I have SUMIF running really really slow. My data has 14,800 Rows and 39 Columns.

I do the following:

      Application.ScreenUpdating = False

Application.DisplayStatusBar = False

Application.Calculation = xlCalculationManual

Application.EnableEvents = False

ActiveSheet.DisplayPageBreaks = False

EDITED TO ADD more potentially relevant code that may be interacting with the SUMIF command

It may be relevant to the speed issue so I'll mention it. I get the user to open a file from wherever they may have stored the report. The file then stays open. Maybe that is a problem. I don't know if it should be some other way.. like I close it but keep the address in mind or something??

    FilterType = "Text Files (*.txt),*.txt," & "Comma Separated Files (*.csv),*.csv," & "ASCII Files (*.asc),*.asc," & "All Files (*.*),*.*"

        FilterIndex = 4

        Title = "File to be Selected"

        File_path = Application.GetOpenFilename(FileFilter:=FilterType, FilterIndex:=FilterIndex, Title:=Title)

            If File_path = "" Then

                MsgBox "No file was selected."

            Exit Sub

            End If



        Set wbSource = Workbooks.Open(File_path)
        Original_Name = ActiveWorkbook.Name
        If ActiveSheet.AutoFilterMode Then
            ActiveSheet.AutoFilterMode = False
        End If



     Set wb1 = ActiveWorkbook
    Set ws1 = wb1.Worksheets("Sheet1")

    With ws1

    FinalColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
    FinalRow = .Range("B" & .Rows.Count).End(xlUp).Row



    For j = 1 To FinalColumn
                        If .Cells(1, j).Value = "Effec.Date" Then
                                Effective_Date_Column = j
                        ElseIf .Cells(1, j).Value = "FolderId" Then
                                FolderId_column = j
                        ElseIf .Cells(1, j).Value = "FolderNotional" Then
                                 FolderNotional_column = j

                        End If
         Next j 




    'range_Total_Folder_Fixed = .Cells(2, Total_Folder_Column).Address & ":" & .Cells(FinalRow, Total_Folder_Column).Address

    range_FolderId_Fixed = .Cells(2, FolderId_column).Address & ":" & .Cells(FinalRow, FolderId_column).Address
     range_FolderId_Cell = .Cells(2, FolderId_column).Address(RowAbsolute:=False, ColumnAbsolute:=False)

    range_FolderNotional_Fixed = .Cells(2, FolderNotional_column).Address & ":" & .Cells(FinalRow, FolderNotional_column).Address

Everything runs in 8-10 seconds until we come to the lie below. Now the total time jumps to a 150 seconds.

  .Range(range_Total_Folder_Fixed).Formula = "=SUMIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "," & range_FolderNotional_Fixed & ")"

Am I doing something wrong? Is there a better (more efficient) way to write a general formula?

EDIT: Code generated Raw Formula

Some of the excel worksheet functions in my code:

     .Range(range_Isnumber).Formula = "=(RIGHT(" & range_TradeId_cell & ",2)<> ""IB"")*1"
     .Range(range_Is_IB).Formula = "=(RIGHT(" & range_TradeId_cell & ",2)= ""IB"")*1"

     .Range(range_Exceptions).Formula = "=(SUMIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "," & range_Isnumber_fixed & ")= COUNTIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "))*1+(SUMIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "," & range_Is_IB_fixed & ")= COUNTIF(" & range_FolderId_Fixed & "," & range_FolderId_Cell & "))*1  "
  .Range("C13").FormulaR1C1 = "=SUM(IF(FREQUENCY(MATCH([SCL_FL_2013_11_30.xlsx]Rest!R2C2:R2321C2,[SCL_FL_2013_11_30.xlsx]Rest!R2C2:R2321C2,0),MATCH([SCL_FL_2013_11_30.xlsx]Rest!R2C2:R2321C2,[SCL_FL_2013_11_30.xlsx]Rest!R2C2:R2321C2,0))>0,1))"

So Stuff like

 Range("I2")=SUMIF($H$2:$H$5,H2,$G$2:$G$5)

Where the data could be like

RowG   RowH   RowI

Alice   1      4

Alice    3     4 

Bob      9     17

Bob     8      17

Dan      2      2

EDIT2 : Implementing Sam's solution, I am getting errors:

   Set range_FolderId_Fixed = .Range(.Cells(2, FolderId_column), .Cells(FinalRow, FolderId_column))
   Set range_FolderId_Cell = .Range(.Cells(2, FolderId_column),.Cells(FinalRow, FolderId_column))
   Set range_FolderNotional_Fixed = .Range(.Cells(2, FolderNotional_column), .Cells(FinalRow, FolderNotional_column))
   Set range_Total_Folder_Fixed = .Range(.Cells(2, Total_Folder_Column), .Cells(FinalRow, Total_Folder_Column))

   .Range(range_Total_Folder_Fixed).Value = SumIf_func(range_FolderId_Fixed, range_FolderId_Cell, range_FolderNotional_Fixed)

I am getting a type application defined or object defined error in the line below.

   .Range(range_Total_Folder_Fixed).Value = SumIf_func(range_FolderId_Fixed, range_FolderId_Cell, range_FolderNotional_Fixed)

I have no idea what to do next.

Ok this is what I came up with

 Public Function SumIf_func(rng As Range, _
                            criteria As Range, _
                            sumRange As Range) As Variant()

Dim rngArr() As Variant
Dim sumArr() As Variant
Dim criteriaArr() As Variant
Dim returnArr() As Variant

Dim temp As Double

rngArr = rng.Value2
sumArr = sumRange.Value2
criteriaArr = criteria.Value2

If UBound(sumArr) <> UBound(rngArr) Then _
Err.Raise 12345, "SumIf_func", "Sum range and check range should be the same size"

If UBound(sumArr, 2) <> 1 Or UBound(rngArr, 2) <> 1 Then _
Err.Raise 12346, "SumIf_func", "Sum range and check range should be a single column"

ReDim returnArr(1 To UBound(criteriaArr), 1 To 1)

    For c = LBound(criteriaArr) To UBound(criteriaArr)

            returnArr(c, 1) = Application.WorksheetFunction.SumIf(rng, criteriaArr(c, 1), sumRange)                
    Next c

SumIf_func = returnArr

End Function

This function takes in three ranges:

  • The range to check
  • The range where the criteria are
  • The range where the values to sum are

The range to check and the sum range should both be the same length and only be 1 column across.

The array that is returned will be the same size as the criteria array..

Here is an example of usage:

Public Sub test_SumIf()

Dim ws As Worksheet

Set ws = Sheet1

Dim rng As Range, sumRng As Range, criteria As Range

Set rng = ws.Range("A1:A100")
Set sumRng = ws.Range("B1:B100")
Set criteria = ws.Range("C1:C10")

ws.Range("D1:D10").Value = SumIf_func(rng, criteria, sumRng)

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM