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.