Same Code run on a different sheet runs at a different speed

doggo

Board Regular
Joined
Jan 22, 2004
Messages
115
Ok - Anyone shed some light on this.

I have a procedures that , when I run on Sheet1 takes 0.4s to run. If I run the same code from Sheet3 it takes 3.5s to run?

The procedure processes data from sheet 2 and 3 and can be the only reason why it may be slower when called from sheet 3 - but it still does not make sense to me?
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Do you have an worksheet activate event on the slower sheet?

Is there more data on the slow sheet?
 
Upvote 0
No Activate events on either worksheet.

Alright Smitty - how are you mate. I can post the code but it calls a few other procedures / functions which may make this a little complex to analyze?
 
Upvote 0
This is the proc that is called from both sheets:

Code:
Public Sub RollupData_ExtractCodes(lngTotalRows As Long)
'----------------------------------------------------------------------
' Purpose:   Extract the Brand and Department Codes from "data_File"
'            column in the wsData.  Brand code is placed in the Brand Col
'            and Department in the Dept col
' Returns:   -
' Usage:     call RollupData_ExtractCodes()
' Developer: [MSTEVE]
'-----------------------------------------------------------------------
    
    Dim rngData As Range
    Dim rngAdd As Range
    Dim lngRow As Long
    Dim strFile As String
    Dim arrBrandDept As Variant
    Dim strBrand As String
    Dim strDept As String
    Dim lngAssignRows As Long

    
    On Error GoTo Err_Handler
    
    '--- Set the Data Range to Validate [From data_brand to data_file]
    '--- Loop through the range making the changes
    For Each rngData In wsData.Range("data_Brand").Offset(1, 0) _
                                .Resize(lngTotalRows, g_offData_MCTFile).Rows
    
        'Increment the row number for Progress Status
        lngRow = lngRow + 1
        
        'Tell the user the row we are validating
        Call DisplayProgress("Extracting Brand / Department: Row(" & lngRow & ")")
    
        'Record the file name
        strFile = rngData.Cells(1, g_offData_MCTFile)
        
        'Record the Number of in the Assigned range
        lngAssignRows = TotalRowsInRange(wsAssign.Range("assign_File"))
        
        '--1-- Validate if this File has already been validated and placed in the
        ' assigned sheet.  The user may have already assigned codes
        arrBrandDept = GetUserExtractedCodes(strFile, lngAssignRows)
        
        If Not IsEmpty(arrBrandDept) Then
            
            With rngData
                'Brand Code
                .Cells(1, g_offData_Brand) = arrBrandDept(0)
                
                'Dept Code
                .Cells(1, g_offData_Dept) = arrBrandDept(1)
            End With
            
        Else
            '--2-- Otherwise, try to extract the codes programitically
            'Extract the Brand Code
            strBrand = ExtractBrand(strFile)
            rngData.Cells(1, g_offData_Brand) = strBrand
            
            'Extract the Dept Code
            strDept = ExtractDepartment(strFile)
            rngData.Cells(1, g_offData_Dept) = strDept
                
            '--3-- Validate if Either value is blank - if so, write the file to the
            ' manual user assigned list
            If strBrand = g_strUnknownValue Or _
                strDept = g_strUnknownValue Then
                
                '-A- Find the Last Row in the wsAssign Range, increment by one
                Set rngAdd = wsAssign.Range("assign_File").Offset(1 + lngAssignRows, _
                                                    -(g_offAssign_File - g_offAssign_Brand))
                
                '-B- Copy the Template Formate Row and Paste
                wsTemplate.Range("assign_TemplateRow").Copy rngAdd
                    
                '-C- Write the values to the range
                With rngAdd
                    .Cells(1, g_offAssign_Brand) = rngData.Cells(1, g_offData_Brand)
                    .Cells(1, g_offAssign_Dept) = rngData.Cells(1, g_offData_Dept)
                    .Cells(1, g_offAssign_File) = strFile
                    .Cells(1, g_offAssign_RUFile) = rngData.Cells(1, g_offData_RUFile)
                End With
            End If
                
        End If
    
        'Flag the Row as updated
        'rngData.Interior.Color = vbGreen
        
    Next 'rngData
    
EndThis:
    Set rngAdd = Nothing
    Set rngData = Nothing
    Exit Sub
    
Err_Handler:
    Call ShowErrorMessage(Err, "Sub RollupData_ExtractCodes")
    Resume EndThis
    
End Sub

This is the function that tries to extract the Brand and Dept from a file:


Code:
Public Function GetUserExtractedCodes(strFile As String, Optional lngAssignRows As Long) As Variant
'-----------------------------------------------------------------------
' Purpose:     Searches the manually assisgned brand / depts on ws assigned
'              an array with the user values for Brand and Dept
' Usage:       arrBrandDept = GetUserExtractedCodes("myfile.xls", 1)
'              arrBrandDept = GetUserExtractedCodes("myfile.xls")
' Developer:   [MSTEVE]
'-----------------------------------------------------------------------

    Dim rngData As Range
    Dim strBrand As String
    Dim strDept As String
    
    '--- Calc the number if the user did not pass
    If lngAssignRows = 0 Then
        lngAssignRows = TotalRowsInRange(wsAssign.Range("assign_File"))
    End If
    
    '--- Validate that there are rows in the range
    If lngAssignRows > 0 Then
        '--- set the Assigned range Range
        Set rngData = wsAssign.Range("assign_File").Offset(1, 0) _
                                .Resize(lngAssignRows, 1).Find(What:=strFile, lookAt:=xlWhole, _
                                MatchCase:=False)
        
        '--- When it is not nothing then a match was found
        If Not rngData Is Nothing Then
        
            'Fill the array with the brand and Department
            strBrand = rngData.Offset(0, wsAssign.Range("assign_Brand").Column - rngData.Column)
            strDept = rngData.Offset(0, wsAssign.Range("assign_Dept").Column - rngData.Column)
            
            'if either are blank fill with the unknow Value
            If Trim(strBrand) = "" Then strBrand = g_strUnknownValue
            If Trim(strDept) = "" Then strDept = g_strUnknownValue
            
            GetUserExtractedCodes = Array(strBrand, strDept)
        End If
    
    End If
    
    'Destroy the Objects
    Set rngData = Nothing

End Function
 
Upvote 0

Forum statistics

Threads
1,203,257
Messages
6,054,408
Members
444,723
Latest member
Gagan sree ram

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top