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.