Is there a way to speed up this VBA macro that uses ranges from two different workbooks?

Question

I'm hoping someone can help me here, I'm working with a file which has about 38000 rows and 180 columns. I'm using a macro to update the fields in the one workbook with the values in the other workbook, but it takes about 2 minutes to run. I'm looking for a way to reduce this time, I've tried everything I could find on previous questions but it's still too long.

As you can see in the code below, the macro checks to see the # of rows are the same in each workbook (note the one has 1 more row, hence the lastrow temp having +1) and then I want to check if the field in the temp file is a certain colour, if not then change it if etc... I use this colour to keep track of the values that have changed from the raw file, as I don't want these values to be overwritten again once they have been changed once. I use ranges so that I don't need to access the worksheets the entire time as this increases the execution time. Any help will be appreciated.

Sub SavetoTemp()

    StartTime = Timer
    Set wb = ThisWorkbook
    Set DT = wb.Worksheets("Data Table")

     With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
        .ActiveSheet.DisplayPageBreaks = False
        DT.DisplayPageBreaks = False
    End With

    Dim TempFile As Workbook
    Dim TempSheet As Worksheet
    Dim LastCol As Long
    Dim colLetEnd As String

    If wb.Worksheets("Steering Wheel").Range("M30").Value = "" Then
        MsgBox "Please Select a Temporary File First"
        Exit Sub
    Else
        Set TempFile = Workbooks.Open(Range("M30").Value)
        Set TempSheet = TempFile.Worksheets(1)

        Dim LastRowDT As Long
        LastRowDT = DT.Cells(Rows.Count, "A").End(xlUp).row
        LastCol = DT.Cells(1, Columns.Count).End(xlToLeft).Column

        Dim LastRowTemp As Long
        LastRowTemp = TempSheet.Cells(Rows.Count, "A").End(xlUp).row + 1

        Dim tempCell As Range
        Dim r As Long
        Dim c As Long
        Dim rngDT As String
        Dim rngTemp As Range
        colLetEnd = Split(Cells(1, LastCol).Address, "$")(1)
        Set rngTemp = TempSheet.UsedRange
        rngDT = "A" & 3 & ":" & colLetEnd & LastRowDT

        If (LastRowTemp = LastRowDT) Then
            For Each cell In DT.Range(rngDT)
                Set tempCell = rngTemp.Cells(cell.row - 1, cell.Column)
                If Not tempCell.Interior.Color = RGB(188, 146, 49) Then
                    If IsNumeric(cell) And Not IsEmpty(cell) Then
                        If (Not cell = tempCell) Or (IsEmpty(tempCell)) Then
                            tempCell.Interior.Color = RGB(188, 146, 49)
                            tempCell = cell
                        End If
                    Else
                        If Not (StrComp(cell, tempCell, vbTextCompare) = 0) Then
                            tempCell.Interior.Color = RGB(188, 146, 49)
                            tempCell = cell
                        End If
                        End If
                    End If
            Next cell


            TempSheet.Cells.EntireColumn.AutoFit
            TempFile.Save
            TempFile.Close

            MsgBox "All Records Saved to Temp File Successfully!"
            wb.Worksheets("Steering Wheel").Activate
            MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
            wb.Worksheets("Steering Wheel").Range("E48").Value = MinutesElapsed
            With Application
                .Calculation = xlCalculationAutomatic
                .ScreenUpdating = True
                .DisplayStatusBar = True
                .EnableEvents = True
            End With
            Else
            MsgBox "Please load the raw data file into your temp file before saving to it."
            With Application
                .Calculation = xlCalculationAutomatic
                .ScreenUpdating = True
                .DisplayStatusBar = True
                .EnableEvents = True
            End With
            Exit Sub
        End If
    End If
End Sub

Any improvement to the code to reduce execution time is my ultimate goal.

Note that you should have an error handler in place, especially when turning off automatic calculation and workbook events. You can read more about it [here](https://excelmacromastery.com/vba-error-handling/). — riskypenguin, Oct 21 '19 at 08:20
I recently saw a question with a similar issue. [This answer](https://stackoverflow.com/a/58304857/11936678) might come of use to you. Instead of looping over each cell and changing their values and colours, you could reach both ranges into arrays and compare those, then apply all changes at once. — Plutian, Oct 21 '19 at 08:26
If this code works and has no actual issue (no errors), this question is better asked at https://codereview.stackexchange.com. — Pᴇʜ, Oct 21 '19 at 08:26
Anyhow, with your strategy, you are enforcing to check all the cells on the range. As the range is what it is... there will not be too much improvement. In my personal opinion, you should try to introduce one auxiliary column that act as trigger just if there is any value that change, so you will just check by row and not by cell. — David García Bodego, Oct 21 '19 at 09:15
A quicker way would be to get your range into an array and step through the array and then maybe transpose your result to the intended sheet. Some tips: 1. `Option Explicit` is your friend. 2. Try not to use excel reserved words as your variable names (i.e. **`cell`**) — Zac, Oct 21 '19 at 09:27

Is there a way to speed up this VBA macro that uses ranges from two different workbooks?

0 Answers0