0
\$\begingroup\$

Code explanation: I have a code, which performs two tasks -

  1. To open two workbooks, one being extract info and one destination and it compares the column A with Column A of these workbooks and all matching cells are made vbBlue (Disclaimer:code is made with several other codes from net and with my customisations, id add credit, but I lost the links :().
  2. It sets a range and in the extract file it finds all the vbBlue cells and selects their entire rows, then the selection is pasted into the destination folder.

What is the issue:

Now, funny thing is this code work for me well, but for small amounts of rows, I have a file with 70000 rows and 350000 rows and What I managed to dig up is that the row.count (LastRow function) is making it incredibly slow, now I could manually put my ranges and its holidays right... Well I tried and the part, which does : For i = 2 to LastRow does not do what I thought it would. So I need assistance in how to make this code faster, because this is the deBugging part, which made me stuck.

Update: Apparently arrays would make this work faster than flash himself, but its out of my scope to arrange them here, I keep getting errors, if ill manage ill update here..

Sub moduleUpdate()

    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim recRow As Long
    Dim lastRow As Long
    Dim fCell As Range
    Dim i As Long
    Dim rCell As Range
    Dim LastRows As String
    Dim cell As Range
    Dim rng As Range
    Dim FoundRange As Range

    LastRows = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
    Set DstFile = Workbooks("ExtractFile.xlsx")
    Set wsSource = Workbooks("ExtractFile.xlsx").Worksheets("Sheet1")
    Set wsDest = Workbooks("Workbook.xlsx").Worksheets("Sheet1")

    Application.ScreenUpdating = False

    recRow = 1

    With wsSource
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 2 To lastRow
            'See if item is in Master sheet
            Set fCell = wsDest.Range("A:A").Find(what:=.Cells(i, "A").Value, LookAt:=xlWhole, MatchCase:=False)

            If Not fCell Is Nothing Then
                'Record is already in master sheet
                recRow = fCell.Row
            Else

                .Cells(i, "A").Interior.Color = vbBlue
                recRow = recRow + 1

            End If
        Next i
    End With

    Set rng = Range("A1:A90000")
    LastRows = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
    For Each cell In rng.Cells
        If cell.Interior.Color = vbBlue Then
            If FoundRange Is Nothing Then
                Set FoundRange = cell
            Else
                Set FoundRange = Union(FoundRange, cell).EntireRow
            End If
        End If
    Next cell
    
    If Not FoundRange Is Nothing Then FoundRange.Select
    
    Selection.Copy
    Workbooks("Workbook.xlsx").Activate
    ActiveWorkbook.Sheets("Sheet1").Activate
    LastRows = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
    Range("A" & LastRows).Select
    Workbooks("Workbook.xlsx").Worksheets("Sheet1").PasteSpecial
    'If Not FoundRange Is Nothing Then FoundRange.Select





    'Clean up
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    'DstFile.Save
    'DstFile.Close

End Sub

\$\endgroup\$

1 Answer 1

0
\$\begingroup\$

Before getting to speed improvements, there are some structural and language best practices to address.

Best Practice: Always declare Option Explicit at the top of the module to ensure all variable used in your code are declared more info here . Make it automatic: in the VBIDE, check the 'Tools -> Options... -> (Editor tab) Require Variable Declaration' option.

Best Practice: If Application flags must be set and reset, use error handling to guarantee that it happens. The current code is structured as:

Sub moduleUpdate()
    
'{declarations}

'{set workbook/worksheet variables}

    Application.ScreenUpdating = False
    
'{executable code...} <= if an error/exception occurs in any of this code, the 'Clean up' code is not executed


    'Clean up
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    'DstFile.Save
    'DstFile.Close

End Sub

Instead, use the On Error Goto XXX statement to guarantee that the 'Clean up' code is executed

Option Explicit

Sub moduleUpdate()
    
'{declarations}

'{set workbook/worksheet references}

    Application.ScreenUpdating = False
    
On Error Goto Cleanup '<= guarantees that the 'Clean up' code executes
    
'{executable code...} <= if an error/exception occurs in any of this code, execution jumps to the 'Cleanup:' label


Cleanup:
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    'DstFile.Save
    'DstFile.Close

End Sub

Best Practice: Avoid use of ActiveWorkbook and ActiveSheet. Instead, create dedicated variables that hold references to these documents. Using ActiveWorkbook and ActiveSheet may result in unexpected workbook and sheet references. This is an excellent resource regarding not using Select, ActiveSheet, etc.

The code sets up dedicated variables here:

    Dim DstFile As Workbook
    Set DstFile = Workbooks("ExtractFile.xlsx")
    
    Dim wsSource As Worksheet
    Set wsSource = Workbooks("ExtractFile.xlsx").Worksheets("Sheet1")
    
    Dim wsDest as Worksheet
    Set wsDest = Workbooks("Workbook.xlsx").Worksheets("Sheet1")

As a new reader of the code, DstFile and wsDest names are confusing since 'Dst' and 'Dest" both look like abbreviation of the word 'destination'. To avoid this situation the code below changes the variable names as follows:

    Dim extractWorkbook As Workbook
    Set extractWorkbook = Workbooks("ExtractFile.xlsx")
    
    Dim extractWorksheet As Worksheet
    Set extractWorksheet = extractWorkbook.Worksheets("Sheet1")
    
    Dim wsDest as Worksheet
    Set wsDest = Workbooks("Workbook.xlsx").Worksheets("Sheet1")

The expression:

    LastRows = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

is executed 3 times within the code, but the result LastRow is only used once.

The first time this expression is executed, it is unclear what is the 'ActiveSheet'.

It took some experimenting with fake data files, but it seems that for this code to work, the moduleUpdate must be invoked while "ExtractFile.xlsx" is the active worksheet. Rather than counting on this condition to pre-exist, simply drop the use of ActiveSheet and use variable extractWorksheet.

The second time it is invoked, it is more apparent that ActiveSheet refers to extractWorksheet. Again, it doesn't really matter since this assignment to LastRow is not used - but it is better to explicitly use variable extractWorksheet.

The third time the expression is invoked, wsDest is activated so it is now the 'ActiveSheet':

    Selection.Copy '<= copies the selection of the ActiveSheet (extractWorksheet) to the clipboard
    
    Workbooks("Workbook.xlsx").Activate '<= the workbook containing wsDest becomes the 'ActiveWorkbook'
    ActiveWorkbook.Sheets("Sheet1").Activate ' <= wsDest is the ActiveSheet
    LastRows = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 'last row of the `ActiveSheet (wsDest)
    Range("A" & LastRows).Select '<= this is a Range within the 'ActiveSheet (wsDest)
    'Now, rather than use 'ActiveSheet' OR wsDest, the paste target is explicitly identified !?
    Workbooks("Workbook.xlsx").Worksheets("Sheet1").PasteSpecial

So, certainly the first 2 expression can be deleted. It may not speed up execution, but removing all the implicit references to the ActiveSheet is an improvement to the 3rd use of LastRows.

Using faked data and the original code, the logic seems to copy rows from extractWorksheet to wsDest where a matching value is not found. This behavior does not quite agree with your description, but it makes sense if the goal is to copy 'new' rows from extractWorksheet to wsDest worksheet. So, the remainder of this answer assumes this observation is correct.

One last Best Practice: Within Subroutines and Functions, declare local variables close to their initial use. Makes code easier to read/interpret.

Now...speed

There are two loops in the current code. Each loop iterates presumably thousands of times. So, to speed up execution, the code below employs the suggested best practices and does the following to improve execution speed.

  1. Declare/Initialize objects and reference values from objects once (outside of the loop) as much as possible. These kinds of operations can be an expensive when done thousands of times.
  2. Iterate through the datasets using a single loop instead of two. Evaluate for a match and copy the data if required within the same iteration.
  3. Avoid copy/paste operations using the clipboard
Option Explicit

Sub moduleUpdate()

    Dim extractWorkbook As Workbook
    Set extractWorkbook = Workbooks("ExtractFile.xlsx")
    
    Dim extractWorksheet As Worksheet
    Set extractWorksheet = extractWorkbook.Worksheets("Sheet1")
    
    Dim wsDest As Worksheet
    Set wsDest = Workbooks("Workbook.xlsx").Worksheets("Sheet1")

On Error GoTo Cleanup
    Application.ScreenUpdating = False

    Dim recRow As Long
    recRow = 1

    With extractWorksheet
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        'Create the Range object to search with 'Find once...declare and initialize it outside of the loop
        Dim wsDestRange As Range
        Set wsDestRange = wsDest.Range("A:A")
        
        'Determine where to begin appending rows of data to wsDest worksheet
        Dim wsDestNextRowNumber As Long
        wsDestNextRowNumber = wsDest.Cells(Rows.Count, "A").End(xlUp).Row + 1

        Dim fCell As Range 'this needs a better name, 'fCell" is not descriptive
        Dim extractWorksheetCell As Range
        Dim rowNum As Long
        For rowNum = 2 To lastRow
            Set extractWorksheetCell = .Cells(rowNum, "A")
            Set fCell = wsDestRange.Find(what:=extractWorksheetCell.Value, LookAt:=xlWhole, MatchCase:=False)
            If fCell Is Nothing Then 'Value does not exist in the wsDest worksheet
                'Is setting the color really required, or was the color attribute used used as a marker?
                extractWorksheetCell.Interior.Color = vbBlue
                'Append the entire row's content to the wsDest worksheet
                extractWorksheetCell.EntireRow.Copy wsDest.Range("A" & CStr(wsDestNextRowNumber))
                wsDestNextRowNumber = wsDestNextRowNumber + 1
            End If
        Next rowNum
    End With

Cleanup:
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub


If the above changes do not speed up execution sufficiently, then you may need to investigate manipulations using arrays, collections and dictionaries. Good luck!

\$\endgroup\$

Not the answer you're looking for? Browse other questions tagged or ask your own question.