Consulting

Results 1 to 11 of 11

Thread: Slow Calculation of Sum Row

  1. #1
    VBAX Newbie
    Joined
    Apr 2021
    Posts
    5
    Location

    Slow Calculation of Sum Row

    Good Morning,

    I am a beginner in VBA and am trying to improve performance of my doc control register. The current code works fine, however when this is updated to have data return value on a different worksheet, or values summed onto a different worksheet it takes 5 to 8 mins to process all info. The example included is significantly reduced, we have about 2000 lines that need to be processed.

    The goal of the code is to check all documents on our 'Cross-Referencing Docs' sheet that have other docs referenced within them and check these doc #'s against our 'Doc Register' list, and then colour code if 'Inactive' or do not exist (Bad ID). Currently, after completing this check, the code does a count on the total number of Inactive or Bad ID docs per row and returns the value at the end of the row, however we want the result to be on the 'Doc Register' sheet.

    Below is the code we used the have the value's return on the Doc Register worksheet instead of the Cross-Referencing sheet - We have also attempted to use a Sum code and then calling that after completion of the count, also below.
    Sub Check_For_Inactive_References()
    
    
    '=====declare variables======================================================================
    Dim Inactive_Reference_Count As Integer
    Dim BadDocID_Count As Integer
    Dim ColumnRange As Range
    Dim StartRow As Integer
    Dim EndRow As Integer
    Dim StartColumn As String
    Dim Inactive_Total_Column As String
    Dim Bad_ID_Total_Column As String
    
    
    '=====initialise variables=====================================================================
    StartRow = 2
    EndRow = 2000
    StartColumn = "I"
    EndColumn = "Z"
    Inactive_Total_Column = "G"  'IF WE USE THE SUM FUNCTION, THIS WILL BE "CY"
    Bad_ID_Total_Column = "H"   'IF WE USE THE SUM FUNCTION, THIS WILL BE "CZ"
    
    
    MsgBox ("Checking for totals against each Doc ID, please wait")
    
    
    '=====scan through all rows in the sheet and then execute the "for each" function within this loop for each row===
    Do Until StartRow > EndRow 'keep looping until the counter gets up to the last row
    
    
    '=====Check the row the script is up to for number of inactive and bad ID documents===========
            For Each ColumnRange In Sheet3.Range(StartColumn & StartRow & ":" & EndColumn & StartRow)
                
                Select Case ColumnRange.Interior.ColorIndex 'check the color of the current cell
                    Case Is = 3 'if the current cell is RED
                        Inactive_Reference_Count = Inactive_Reference_Count + 1 'Increase inactive counter for the current row by 1
                    Case Is = 7 'if the current cell is MAGENTA
                        BadDocID_Count = BadDocID_Count + 1 'increase bad doc ID counter for the current row by 1
                    Case Else
                        'do nothing
                End Select
            
            Next ColumnRange
        
            Sheet2.Range(Inactive_Total_Column & StartRow) = Inactive_Reference_Count 'write inactive count total against the row in sheet - IF WE USE THE SUM FUNCTIONS THIS WILL BE SHEET3
            Sheet2.Range(Bad_ID_Total_Column & StartRow) = BadDocID_Count 'write bad doc id count total against the row in sheet - IF WE USE THE SUM FUNCTIONS THIS WILL BE SHEET3
            
            Inactive_Reference_Count = 0 'once values are written to the sheet, reset them back to 0 ready for next row
            BadDocID_Count = 0 'once values are written to the sheet, reset them back to 0 ready for next row
    '===============================================================================================
           
        StartRow = StartRow + 1 'increment to the next row and repeat the loop again
    
    
    Loop
    
    
    MsgBox ("Complete")
    
    
    End Sub

    SUM OF COUNT:

    Sub COUNT_DODGY_DOCS()
    
    
    On Error Resume Next
    Dim Count_Inactive_Row As Long
    Dim Dept_Clm As Long
    Table1 = Sheet2.Range("B2:H2000")
    Table2 = Sheet3.Range("D2:CZ2000")
    
    
    Count_Inactive_Row = Sheet2.Range("G2").Row
    Dept_Clm = Sheet2.Range("G2").Column
    For Each cl In Table1
     Sheet2.Cells(Count_Inactive_Row, Dept_Clm) = Application.WorksheetFunction.VLookup(cl, Table2, 100, False)
     Count_Inactive_Row = Count_Inactive_Row + 1
     
    Next cl
    
    
    
    
    End Sub
    Any help would be appreciated.

    Thanks

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,825
    Location
    I only looked at COUNT_DODGY_DOCS

    The first tow subs seems to run pretty quick, but this one was really slow since you were doing what seemed to be a lot of unnecessary processing (extra rows, all cells in a Table, etc.)

    I used 2 arrays for speed, and I've found for me at least I make less mistakes if I use A1:something-something instead of B2:H2000 since cells counts/indices are relative to the over-arching Range (i.e. Cells(1,1) in B2:H2000 is B2)

    I just want to avoid silly mistakes

    Option Explicit
    
    
    Sub COUNT_DODGY_DOCS()
        Dim Table2 As Range, Table3 As Range
        Dim Dept_Clm As Long
        Dim rowLast2 As Long, rowLast3 As Long, rowInactive As Long, n As Long
        Dim sDoc As String
        Dim aryCol4 As Variant, aryCol104 As Variant
    
    
        With Sheet2 '   Doc Register sheet
            rowLast2 = .Cells(.Rows.Count, 2).End(xlUp).Row
            Set Table2 = .Cells(1, 1).Resize(rowLast2, 7)
        End With
        
        With Sheet3 '   Cross Ref Docs sheet
            rowLast3 = .Cells(.Rows.Count, 4).End(xlUp).Row
            Set Table3 = .Cells(1, 1).Resize(rowLast3, 104)
            aryCol4 = Application.WorksheetFunction.Transpose(Table3.Columns(4))
            aryCol104 = Application.WorksheetFunction.Transpose(Table3.Columns(104))
        End With
    
    
        Dept_Clm = 7
        
        For rowInactive = 2 To rowLast2
            sDoc = Table2.Cells(rowInactive, 2).Value
            
            n = 0
            On Error Resume Next
            n = Application.WorksheetFunction.Match(sDoc, aryCol4, 0)
            On Error GoTo 0
            
            If n = 0 Then
                Table2.Cells(rowInactive, Dept_Clm) = ""
            Else
                Table2.Cells(rowInactive, Dept_Clm) = aryCol104(n)
            End If
        Next rowInactive
    
    
        MsgBox "Complete"
    
    
    End Sub
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    VBAX Newbie
    Joined
    Apr 2021
    Posts
    5
    Location
    Hi Paul,
    Thanks for responding. I did run your code and it has shaved some time off, however still sitting at 3 minutes (ish) to run all 3 codes together. I was really hoping to have this time reduced down to less than a minute but will take onboard your advice and keep playing with it to see if I can get something to stick.

  4. #4
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,187
    I looked at: Sub Check_For_Inactive_Documents()

    Why don't you use 2 ( red & magenta) simple conditional formatting rules in range I2:Z2000 in sheet 'cross referencing docs' ?
    You don't need any VBA for this;
    You won't even notice the calculation time.

    To count the inactive lines: use countif instead of VBA.

  5. #5
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,187
    To reduce execution time in VBA:

    Only read data form a workbook once.
    Only write results into a workbook once.

    Avoid any other reading/writing opeerations in any worksheet.

    Use Arrays to store data in.
    Use Arrays to do the calculations.

    Open any other files using GetObject.

    Avoid the use of Excel formulae (worksheetfunctions).

    Use Dictionaries if many comparisons are required.


    NB. Application screenupdating=false & application.calculation=manual are only an indication that the interaction between the code and the workbook is too unnecessarily frequent.

  6. #6
    VBAX Newbie
    Joined
    Apr 2021
    Posts
    5
    Location
    Hi snb,

    We originally had this set as a conditional format, however we couldn't work out a function to count each conditionally-coloured cell per row.

    We have approx 80 columns and 2000 rows of data so nesting countif and vlookups for this many cells isn't something we want to consider at this stage.

    Are you aware of any basic functions that could be used instead of vba to counter this?

  7. #7
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,187
    Why would you like to count the number of coloured cells per row ?

  8. #8
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,187
    Why would you like to count the number of coloured cells per row ?
    You'd better use a comparable formula as used for the conditional formatting.

  9. #9
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,187
    Definitely the fastest way to count the 'inactives' and 'Bads':

    Sub M_snb()
      sp = Sheet2.ListObjects(1).DataBodyRange
      sn = Sheet3.ListObjects(1).DataBodyRange
        
      With CreateObject("scripting.dictionary")
        For j = 1 To UBound(sp)
          .Item(sp(j, 2)) = sp(j, 17)
        Next
            
        For j = 1 To UBound(sn)
          sn(j, UBound(sn, 2)) = 0
          sn(j, UBound(sn, 2) - 1) = 0
               
          For jj = 6 To 22
            If .exists(sn(j, jj)) Then
              If .Item(sn(j, jj)) = "Inactive" Then sn(j, UBound(sn, 2) - 1) = sn(j, UBound(sn, 2) - 1) + 1
            ElseIf sn(j, jj) <> "X" And sn(j, jj) <> "" Then
              sn(j, UBound(sn, 2)) = sn(j, UBound(sn, 2)) + 1
            End If
          Next
    
          If sn(j, UBound(sn, 2)) = 0 Then sn(j, UBound(sn, 2)) = ""
          If sn(j, UBound(sn, 2) - 1) = 0 Then sn(j, UBound(sn, 2) - 1) = ""
        Next
      End With
        
      Sheet3.ListObjects(1).DataBodyRange = sn
    End Sub

  10. #10
    VBAX Newbie
    Joined
    Apr 2021
    Posts
    5
    Location
    Hi snb,

    This is fantastic - There is only one more issue that seems to be plaguing me and I can't seem to find where it is driven from.

    The 'Status' column on Cross-Referencing is derived from the Doc Register Page. Each time I run the calc, it overrides the Vlookup formula to paste the value in as a text into the Status column. Seeing as this value is something that is constantly changing, I was hoping to keep the formula in there. Would this possible?

    Thanks

  11. #11
    VBAX Newbie
    Joined
    Apr 2021
    Posts
    5
    Location
    Hi snb,

    I managed to work it out, this has solved al of my issues. you are a star!

    Thsnks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •