Consulting

Results 1 to 10 of 10

Thread: 2010 macro runs slow in 2016 and display result is different

  1. #1
    VBAX Regular
    Joined
    Sep 2018
    Posts
    6
    Location

    2010 macro runs slow in 2016 and display result is different

    Hello,
    I have the following(see below) "File Search Utility" macro that I have been using in Excel 2010. This macro searches through a specified folder of workbooks and returns the desired data (love this macro!).

    In Excel 2010, the search (which searches 450+ files) takes about 2 minutes and displays the results AS they are found.

    In Excel 2016, the search takes more than double the time, and no results are displayed until the macro has completely run through all of the files in the folder.

    I am a novice to intermediate macro programmer at best (i.e. I know enough to be dangerous). Any help to tweak this code would be greatly appreciated. As a side note, on Many occasions I have received top notch help on this forum, and have met the nicest of people... Thank you!

    Option Explicit
    
    
    Public Sub SearchButton_Click()
      Dim astrWorkbooks() As String
      Dim strPartNumber As String
      Dim strFolderPath As String
      Dim vntWorkbooks As Variant
      Dim j As Long
      On Error GoTo ErrHandler
      If Not ValidateData("PartNumber", strPartNumber) Then
        MsgBox "Part number has not been entered.", vbExclamation
        Exit Sub
      End If
      If Not ValidateData("SearchFolder", strFolderPath) Then
        MsgBox "Search folder has not been entered.", vbExclamation
        Exit Sub
      End If
      Call ClearResultsTable
      If Not FolderExists(strFolderPath) Then
        MsgBox "Search folder does not exist.", vbExclamation
        Exit Sub
      End If
      vntWorkbooks = GetAllWorkbooks(strFolderPath)
      If IsEmpty(vntWorkbooks) Then
        MsgBox "Search folder does not contain any Excel workbooks.", vbExclamation
        Exit Sub
      End If
      astrWorkbooks = vntWorkbooks
      For j = LBound(astrWorkbooks) To UBound(astrWorkbooks)
        Call SearchWorkbook(astrWorkbooks(j), strPartNumber)
      Next j
      MsgBox "Search has completed. Please check results table.", vbInformation
      Exit Sub
    ErrHandler:
      MsgBox Err.Description, vbExclamation
    End Sub
    
    
    Private Function FolderExists(ByRef strFolderPath As String) As Boolean
      On Error GoTo ErrHandler
      If Right(strFolderPath, 1) <> Application.PathSeparator Then
        strFolderPath = strFolderPath & Application.PathSeparator
      End If
      FolderExists = (Dir(strFolderPath, vbDirectory) <> "")
      Exit Function
    ErrHandler:
      FolderExists = False
    End Function
    
    
    Private Sub ClearResultsTable()
      Dim tblResults As ListObject
      Dim objFilter As AutoFilter
      Dim rngBody As Range
      Set tblResults = wksSearchUtility.ListObjects("Results")
      Set objFilter = tblResults.AutoFilter
      Set rngBody = tblResults.DataBodyRange
      If Not objFilter Is Nothing Then
        If objFilter.FilterMode Then
          objFilter.ShowAllData
        End If
      End If
      If Not rngBody Is Nothing Then
        rngBody.Delete
      End If
    End Sub
    
    
    Private Function ValidateData(ByVal strRangeName As String, ByRef strData As String) As Boolean
      On Error GoTo ErrHandler
      strData = UCase(Trim(wksSearchUtility.Range(strRangeName).Text))
      ValidateData = (strData <> vbNullString)
      Exit Function
    ErrHandler:
      ValidateData = False
    End Function
    
    
    Private Function GetAllWorkbooks(strFolderPath As String) As Variant
      Dim lngWorkbookCount As Long
      Dim astrWorkbooks() As String
      Dim strFileName As String
      Dim strFilePath As String
      On Error GoTo ErrHandler
      strFileName = Dir(strFolderPath & "*.xl*")
      Do Until (strFileName = vbNullString)
        lngWorkbookCount = lngWorkbookCount + 1
        strFilePath = strFolderPath & strFileName
        ReDim Preserve astrWorkbooks(1 To lngWorkbookCount)
        astrWorkbooks(lngWorkbookCount) = strFilePath
        strFileName = Dir()
      Loop
      If lngWorkbookCount > 0 Then
        GetAllWorkbooks = astrWorkbooks
      Else
        GetAllWorkbooks = Empty
      End If
      Exit Function
    ErrHandler:
      GetAllWorkbooks = Empty
    End Function
    
    
    Private Sub SearchWorkbook(strFilePath As String, strPartNumber As String)
      Dim sht As Worksheet
      Dim wbk As Workbook
      On Error GoTo ErrHandler
      Application.DisplayAlerts = False
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
      Set wbk = Workbooks.Open(strFilePath, False)
      For Each sht In wbk.Worksheets
        Call SearchWorksheet(sht, strPartNumber)
      Next sht
    ExitProc:
      On Error Resume Next
      wbk.Close False
      Application.DisplayAlerts = True
      Application.ScreenUpdating = True
      Application.Calculation = xlCalculationAutomatic
      Exit Sub
    ErrHandler:
      Resume ExitProc
    End Sub
    
    
    Private Sub SearchWorksheet(sht As Worksheet, strPartNumber As String)
      Dim rngTableRow As Range
      Dim cell As Range
      On Error GoTo ErrHandler
      For Each cell In Intersect(sht.Columns("B"), sht.UsedRange).Cells
        If UCase(cell.Text) Like "*" & strPartNumber & "*" Then
          Set rngTableRow = GetNextRow()
          rngTableRow.Item(1).Value = sht.Parent.Name
          rngTableRow.Item(2).Value = cell.Text
          rngTableRow.Item(3).Value = cell.Offset(, -1).Value
          rngTableRow.Item(4).Value = cell.Offset(, 6).Value
          rngTableRow.Item(5).Value = cell.Offset(, 7).Value
          rngTableRow.Item(6) = Range("I3")
        End If
      Next cell
      Exit Sub
    ErrHandler:
    End Sub
    
    
    Private Function GetNextRow() As Range
      With wksSearchUtility.ListObjects("Results")
        If .InsertRowRange Is Nothing Then
          Set GetNextRow = .ListRows.Add.Range
        Else
          Set GetNextRow = .InsertRowRange
        End If
      End With
    End Function
    Last edited by Paul_Hossler; 09-19-2018 at 10:30 AM. Reason: Added CODE tags

  2. #2
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    What is wksSearchUtility?
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    VBAX Regular
    Joined
    Sep 2018
    Posts
    6
    Location
    Quote Originally Posted by p45cal View Post
    What is wksSearchUtility?
    I believe,The name of the worksheet being used as the search utility. I had help writing a lot of this macro so forgive me if i'm not sure.

    in other words, I open an Excel file that contains the layout for the search , and the name of the worksheet is "Search Utility"

    However, in looking at it further, it looks like it is part of defining and outputting the table rows as the results are found.
    Last edited by jaswes; 09-19-2018 at 12:11 PM.

  4. #4
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Late response, I realise.
    I can't see why the two versions of Excel should be so different in execution time but what do I know?
    I think I can speed this macro up considerably by reducing the number of times the sheets are read from/written to by reading the information into memory in one hit and writing the information to the sheet in one hit, but it would take me a long time to recreate a workbook with a lot of (incorrect) guessing as to what's what and where and the kinds of data involved in your setup.
    If you could attach a mockup of your workbook along with some sample workbooks that you're interrogating I could try to simulate your situation here and experiment and develop a slicker solution.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  5. #5
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,720
    Location
    In my experience, every version has become slower since 2003.
    Be as you wish to seem

  6. #6
    VBAX Regular
    Joined
    Sep 2018
    Posts
    6
    Location
    Quote Originally Posted by p45cal View Post
    Late response, I realise.
    I can't see why the two versions of Excel should be so different in execution time but what do I know?
    I think I can speed this macro up considerably by reducing the number of times the sheets are read from/written to by reading the information into memory in one hit and writing the information to the sheet in one hit, but it would take me a long time to recreate a workbook with a lot of (incorrect) guessing as to what's what and where and the kinds of data involved in your setup.
    If you could attach a mockup of your workbook along with some sample workbooks that you're interrogating I could try to simulate your situation here and experiment and develop a slicker solution.
    Thank you so much for the response. I will put that data together and post a link to it here ASAP. No worries on the late response, I am grateful for any reply and help at all.
    "Nobody cares how much you know....Until they know how much you care."

  7. #7
    VBAX Regular
    Joined
    Sep 2018
    Posts
    6
    Location

    Link to Test Data and Search Utility Workbook

    "Nobody cares how much you know....Until they know how much you care."

  8. #8
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Try the attached.
    I did rewrite to reduce sheet read/write operations down to one per sheet but it didn't significantly reduce execution time, because most of the time was spent opening and closing the workbooks.
    A second rewrite uses a different technique.
    It does expect to see a sheet called Invoice in every interrogated workbook, and it expects all the data in those sheets to be within row 2 to row 38 but this can be extended by changing the line:
    BlockSize = 37
    Attached Files Attached Files
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  9. #9
    VBAX Regular
    Joined
    Sep 2018
    Posts
    6
    Location

    Thank you!

    Quote Originally Posted by p45cal View Post
    Try the attached.
    I did rewrite to reduce sheet read/write operations down to one per sheet but it didn't significantly reduce execution time, because most of the time was spent opening and closing the workbooks.
    A second rewrite uses a different technique.
    It does expect to see a sheet called Invoice in every interrogated workbook, and it expects all the data in those sheets to be within row 2 to row 38 but this can be extended by changing the line:
    BlockSize = 37
    I will try this as soon as I get into work tomorrow. Thank you so much for putting your valuable time and effort into helping me! Have an awesome day!
    "Nobody cares how much you know....Until they know how much you care."

  10. #10
    VBAX Regular
    Joined
    Sep 2018
    Posts
    6
    Location
    Quote Originally Posted by p45cal View Post
    Try the attached.
    I did rewrite to reduce sheet read/write operations down to one per sheet but it didn't significantly reduce execution time, because most of the time was spent opening and closing the workbooks.
    A second rewrite uses a different technique.
    It does expect to see a sheet called Invoice in every interrogated workbook, and it expects all the data in those sheets to be within row 2 to row 38 but this can be extended by changing the line:
    BlockSize = 37
    This is incredible! I can't thank you enough! A search that was taking my computer almost 4-1/2 minutes is now taking less than 5 seconds. This is so beneficial to my company for searching past invoices. You are a true blessing to this forum!
    "Nobody cares how much you know....Until they know how much you care."

Posting Permissions

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