Macro slows down as it runs

[Dean Staples]

Ok I have built this Macro with little knowleadge so any tips would be appriecated.

the Macro gets the User to select the files to be used -it then saves the files with current date & time added to the name.

It then searchs thru 3 sheets in 1 workbook to see if a record is found in the other workbook,

If found it compares price to see if they are different

changes price if different and then writes entries on both sheets accordingly

these 3 sheets have 527 records, 1178 records & 25 records-IF i only search thru first sheet i can complete the updates in 5 mins on my laptop - 16 mins on my work PC

but when i get the macro to switch to the other sheets to update it slows dramtically taking close to an hour to complete on my laptop at home -at work it takes 3 hrs!!!

This is my code to update the first sheet -- to Do the others I simply set the correct price column and change the selected sheet then repeat the process.

Any suggestion / corrections welcome

Sub MicrojetPriceCheck()
Dim bk1 As Workbook, sh1 As Worksheet, cell1, cell11, MicrojetPriceToCompare, microjetdiscountpercentage, microjetupdatecomment As Range
Dim bk2 As Workbook, sh2 As Worksheet, cell2, BudgetPriceToCompare, BudgetUpdateIndicatorTarget, budgetdiscountpercentage, UpIndicator, DownIndicator, BudgetUpdateColumnTarget As Range
Dim bk3 As Workbook, sh3 As Worksheet, cell3 As Range
Dim SupplierCodeColumn, BudgetLastCell As Range
Dim SizeOfMicroJetList As Integer
Dim RowCounter As Integer
Dim TargetRow As Integer
Dim LoopCounter As Integer
Dim BudgetCompatPriceColumn As Integer
Dim BudgetOEMPriceColumn As Integer
Dim UpdateMicroColumn As Integer
Dim UpdateBudgetColumn As Integer
Dim MicrojetPercentageColumn As Integer
Dim BudgetPriceChangeColumn As Integer
Dim BudgetPercentageColumn As Integer
Dim fName As Variant
Dim fNameAndPath As Variant
Dim microjetsavefilename As String
Dim budgetsavefilename As String
Dim SizeOfBudgetPriceList As Integer
Dim SearchValue As String
Dim BudgetLastRow As Long
Dim FirstFindAddress As String
Dim ActualSupplierCode As String
Dim UpdateMicroColumn2ndEntry As Integer

SizeOfMicroJetList = 0
RowCounter = 22
TargetRow = 0
LoopCounter = 0
MicrojetPriceColumn = 5
MicrojetPercentageColumn = 8
BudgetCompatPriceColumn = 39
BudgetOEMPriceColumn = 37
UpdateMicroColumn = 10
UpdateBudgetColumn = 34
SizeOfBudgetPriceList = 0
UpdateMicroColumn2ndEntry = 14
BudgetPriceChangeColumn = 36
BudgetPercentageColumn = 40
ActualSupplierCode = 0
FirstFindAddress = 0
BudgetLastRow = 0
SearchValue = 0
SizeOfBudgetPriceList = 0
budgetsavefilename = 0
microjetsavefilename = 0

Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

MsgBox "Please Select MicroJets New Price Book"
fName = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select Latest MicroJet Price List")
If fName = False Then Exit Sub
Set bk1 = Workbooks.Open(fName)
With ActiveWorkbook
.SaveAs filename:=fName, accessmode:=xlShared
End With
microjetsavefilename = Mid(fName, InStrRev(fName, "\") + 1)
MsgBox "Please Select Budget Master File"
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX), *.XLSX", Title:="Select the Budget Master File")
If fNameAndPath = False Then Exit Sub
Set bk2 = Workbooks.Open(fNameAndPath)
With ActiveWorkbook
.SaveAs filename:=fNameAndPath, accessmode:=xlShared
End With
budgetsavefilename = Mid(fNameAndPath, InStrRev(fNameAndPath, "\") + 1)
Dim MyDate
MyDate = Date
Dim MyTime
MyTime = Time
Dim TestStr As String
TestStr = Format(MyTime, "hh.mm.ss")
Dim RunDate As String
RunDate = Format(MyDate, "DD-MM-YYYY")
FileCopy fName, "C:\Macro-file-backups\" & RunDate & " " & TestStr & " " & microjetsavefilename
FileCopy fNameAndPath, "C:\Macro-file-backups\" & RunDate & " " & TestStr & " " & budgetsavefilename
bk1.ExclusiveAccess
bk1.Close SaveChanges:=False
bk2.ExclusiveAccess
bk2.Close SaveChanges:=False
Set bk1 = Workbooks.Open("C:\Macro-file-backups\" & RunDate & " " & TestStr & " " & microjetsavefilename)
ActiveWorkbook.ExclusiveAccess
Set bk2 = Workbooks.Open("C:\Macro-file-backups\" & RunDate & " " & TestStr & " " & budgetsavefilename)
ActiveWorkbook.ExclusiveAccess

Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
bk1.Unprotect
bk2.Unprotect
Set sh1 = bk1.Worksheets("Inkjet Cartridges")
bk1.Worksheets("Inkjet Cartridges").Activate
Sheets("Inkjet Cartridges").Unprotect "ABC123"
SizeOfMicroJetList = sh1.Cells.SpecialCells(xlLastCell).Row
bk2.Worksheets("Original & Compatibles").Activate
Set sh2 = bk2.Sheets("Original & Compatibles")
BudgetLastRow = sh2.Range("AV" & Rows.Count).End(xlUp).Row
With sh2.Range("AV7:AV" & BudgetLastRow)
    Set BudgetLastCell = .Cells(.Cells.Count)
End With
        
sh2.Cells(2, 37).Font.Name = "Wingdings 3"
sh2.Cells(2, 37).Value = "p"
Set UpIndicator = sh2.Cells(2, 37)
sh2.Cells(2, 41).Font.Name = "Wingdings 3"
sh2.Cells(2, 41).Value = "q"
Set DownIndicator = sh2.Cells(2, 41)
    For RowCounter = 7 To SizeOfMicroJetList
        Set cell1 = sh1.Cells(RowCounter, 1)
            SearchValue = cell1.Value
        Set microjetupdatecomment = sh1.Cells(RowCounter, UpdateMicroColumn)
        Set microjet2ndupdatecomment = sh1.Cells(RowCounter, UpdateMicroColumn2ndEntry)
        
        Set cell2 = sh2.Range("AV7:AV" & BudgetLastRow).Find(What:=SearchValue, _
          after:=BudgetLastCell, _
          LookIn:=xlValues, _
          LookAt:=xlWhole, _
          SearchOrder:=xlByRows, _
          SearchDirection:=xlNext, _
          MatchCase:=False)
        If Not cell2 Is Nothing Then
            FirstFindAddress = cell2.Address
        End If
        If cell2 Is Nothing Then
            microjetupdatecomment.Value = "Record Not Found in Budget Price Book"
        End If
        Do Until cell2 Is Nothing
            If SearchValue = "" Then
                microjetupdatecomment.Value = "Blank not Found"
                Exit Do
            End If
            Set MicrojetPriceToCompare = sh1.Cells(RowCounter, MicrojetPriceColumn) ' NEED A TEXT CHECK HERE on price cell
                TargetRow = cell2.Row
            Set microjetdiscountpercentage = sh1.Cells(RowCounter, MicrojetPercentageColumn)
            
            Set BudgetPriceToCompare = sh2.Cells(TargetRow, BudgetCompatPriceColumn)
            Set BudgetUpdateIndicatorTarget = sh2.Cells(TargetRow, UpdateBudgetColumn)
            Set budgetdiscountpercentage = sh2.Cells(TargetRow, BudgetPercentageColumn)
            Set BudgetUpdateColumnTarget = sh2.Cells(TargetRow, BudgetPriceChangeColumn)
            If BudgetPriceToCompare.Value = MicrojetPriceToCompare.Value Then
                If microjetdiscountpercentage = budgetdiscountpercentage Then
                    microjetupdatecomment.Value = "No Price Change"
                    BudgetUpdateIndicatorTarget.Value = RunDate
                Else
                    microjetupdatecomment.Value = "MicroJet Percentage Changed BUT No Price Change"
                    BudgetUpdateIndicatorTarget.Value = RunDate
                    budgetdiscountpercentage.Value = microjetdiscountpercentage.Value
                End If
            ElseIf BudgetPriceToCompare.Value < MicrojetPriceToCompare.Value Then
                If microjetdiscountpercentage = budgetdiscountpercentage Then
                    microjetupdatecomment.Value = "Price Change Increase"
                    BudgetUpdateColumnTarget.Value = UpIndicator
                    BudgetUpdateIndicatorTarget.Value = RunDate
                    BudgetPriceToCompare.Value = MicrojetPriceToCompare.Value
                Else
                    microjetupdatecomment.Value = "MicroJet Percentage Changed Price Change Increase"
                    BudgetUpdateColumnTarget.Value = UpIndicator
                    BudgetUpdateIndicatorTarget.Value = RunDate
                    BudgetPriceToCompare.Value = MicrojetPriceToCompare.Value
                    budgetdiscountpercentage.Value = microjetdiscountpercentage.Value
                End If
            ElseIf BudgetPriceToCompare > MicrojetPriceToCompare.Value Then
                If microjetdiscountpercentage = budgetdiscountpercentage Then
                    microjetupdatecomment.Value = "Price Change Decrease"
                    BudgetUpdateColumnTarget.Value = DownIndicator
                    BudgetUpdateIndicatorTarget.Value = RunDate
                    BudgetPriceToCompare.Value = MicrojetPriceToCompare.Value
                Else
                    microjetupdatecomment.Value = "MicroJet Percentage Changed Price Change Decrease"
                    BudgetUpdateColumnTarget.Value = DownIndicator
                    BudgetUpdateIndicatorTarget.Value = RunDate
                    BudgetPriceToCompare.Value = MicrojetPriceToCompare.Value
                    budgetdiscountpercentage.Value = microjetdiscountpercentage.Value
                End If
            End If
            Set cell2 = sh2.Range("AV7:AV" & BudgetLastRow).FindNext(after:=cell2)
                If Not cell2.Address = FirstFindAddress Then
                    microjet2ndupdatecomment.Value = "2nd Entry in Budget Price Book"
                End If
                If cell2.Address = FirstFindAddress Then
                    Exit Do
                End If
        Loop
    Next RowCounter
MsgBox "Finished INKJET" & Now()

Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub