Optimize slow VBA response - excel

Question

I need to optimize the vba code used for database updates in my spreadsheet. It would be great if I can get the maximum optimized code. This macro will put currency conversions directly on the report & having to calculate them (The "Exchanges" tab that this report creates uses historical exchange rates )
Sub ZKDP5M()
Application.ScreenUpdating = False
'Add New sheet for marketplace and currency conversions
Sheets.Add After:=ActiveSheet
Sheets("Sheet1").Name = "Exchange Rates"
Range("A1").Select
' Add Marketplaces and Exchange Rates under a new tab
' Update the exchange rates on this tab with the exchange rates under the "Payment" tab of your KDP Report each month to get accurate royalties.
Range("A1").Select
ActiveCell.FormulaR1C1 = "Marketplace"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Conversion Rate"
Range("B2").Select
Columns("A:A").EntireColumn.AutoFit
Range("A2").Select
ActiveCell.FormulaR1C1 = "US"
Range("B2").Select
ActiveCell.FormulaR1C1 = "1"
Range("A3").Select
ActiveCell.FormulaR1C1 = "UK"
Range("B3").Select
ActiveCell.FormulaR1C1 = "1.35"
Range("A4").Select
ActiveCell.FormulaR1C1 = "DE"
Range("B4").Select
ActiveCell.FormulaR1C1 = "1.12"
Range("A5").Select
ActiveCell.FormulaR1C1 = "JP"
Range("B5").Select
ActiveCell.FormulaR1C1 = "0.01"
Range("A6").Select
ActiveCell.FormulaR1C1 = "CA"
Range("B6").Select
ActiveCell.FormulaR1C1 = "0.76"
Range("A7").Select
ActiveCell.FormulaR1C1 = "IT"
Range("B7").Select
ActiveCell.FormulaR1C1 = "1.12"
Range("A8").Select
ActiveCell.FormulaR1C1 = "ES"
Range("B8").Select
ActiveCell.FormulaR1C1 = "1.11"
Range("A9").Select
ActiveCell.FormulaR1C1 = "FR"
Range("B9").Select
ActiveCell.FormulaR1C1 = "1.68"
Range("A10").Select
ActiveCell.FormulaR1C1 = "NL"
Range("B10").Select
ActiveCell.FormulaR1C1 = "1.12"
Range("A11").Select
ActiveCell.FormulaR1C1 = "IN"
Range("B11").Select
ActiveCell.FormulaR1C1 = "0.01"
Range("A12").Select
ActiveCell.FormulaR1C1 = "AU"
Range("B12").Select
ActiveCell.FormulaR1C1 = "0.72"
Range("A13").Select
ActiveCell.FormulaR1C1 = "BR"
Range("B13").Select
ActiveCell.FormulaR1C1 = "0.26"
Range("A14").Select
ActiveCell.FormulaR1C1 = "MX"
Range("B14").Select
ActiveCell.FormulaR1C1 = "0.05"
Range("B15").Select
Columns("B:B").EntireColumn.AutoFit
Range("A1:B1").Select
Selection.Font.Bold = True
'Preserve Data
'This preserves the original data in your report in case you need it.
Sheets("KENP Read").Select
Sheets.Add
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "KENPBeforeConversion"
Sheets("KENP Read").Select
Range("A1:G2").Select
Selection.Copy
Sheets("KENPBeforeConversion").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("KENP Read").Select
Range("E20").Select
Sheets("KENP Read").Select
Application.CutCopyMode = False
'Columns Work
'I included a "Retailer" column for my own purposes, but this may be useful to you if you want to aggregate this report onto a master spreadssheet. You can simply delete or hide if you do not need it.
Range("A1").Select
Selection.EntireRow.Delete
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Retailer"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Month"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Year"
Columns("B:C").Select
Columns("B:C").EntireColumn.AutoFit
Range("A2").Select
Columns("A:A").ColumnWidth = 20.05
Range("H1").Select
ActiveCell.FormulaR1C1 = "KENP"
Range("K1").Select
ActiveCell.FormulaR1C1 = "GBP Conversion"
Range("L1").Select
ActiveCell.FormulaR1C1 = "DE Conversion"
Range("M1").Select
ActiveCell.FormulaR1C1 = "JPY Conversion"
Range("N1").Select
ActiveCell.FormulaR1C1 = "CAD Conversion"
Range("O1").Select
ActiveCell.FormulaR1C1 = "EUR IT Conversion"
Range("P1").Select
ActiveCell.FormulaR1C1 = "EUR ES Conversion"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "EUR FR Conversion"
Range("R1").Select
ActiveCell.FormulaR1C1 = "EUR NL Conversion"
Range("S1").Select
ActiveCell.FormulaR1C1 = "INR Conversion"
Range("T1").Select
ActiveCell.FormulaR1C1 = "AUD Conversion"
Range("U1").Select
ActiveCell.FormulaR1C1 = "BRL Conversion"
Range("V1").Select
ActiveCell.FormulaR1C1 = "MXN Conversion"
Range("W1").Select
ActiveCell.FormulaR1C1 = "USD Conversion"
Range("X1").Select
ActiveCell.FormulaR1C1 = "AdjustedIncome"
Range("Y1").Select
ActiveCell.FormulaR1C1 = "AdjustedCurrency"
Columns("K:Y").Select
Range("Y1").Activate
Columns("K:Y").EntireColumn.AutoFit
Columns("D:D").ColumnWidth = 37.36
'Currency Conversions
'GBP Currency Conversion
Range("K2").Select
ActiveCell.Formula = "=IF(G2=""UK"",'Exchange Rates'!$B$3*I2,0)"
Range("K2").Select
Range("K2").AutoFill Destination:=Range("K2:K1000" & Cells(Rows.Count, "D").End(xlUp).Row)
'DE Currency Conversion
Range("L2").Select
ActiveCell.Formula = "=IF(G2=""DE"",'Exchange Rates'!$B$4*I2,0)"
Range("L2").Select
Range("L2").AutoFill Destination:=Range("L2:L1000" & Cells(Rows.Count, "D").End(xlUp).Row)
'JPY Currency Conversion
Range("M2").Select
ActiveCell.Formula = "=IF(G2=""JP"",'Exchange Rates'!$B$5*I2,0)"
Range("M2").Select
Range("M2").AutoFill Destination:=Range("M2:M1000" & Cells(Rows.Count, "D").End(xlUp).Row)
'CAD Currency Conversion
Range("N2").Select
ActiveCell.Formula = "=IF(G2=""CA"",'Exchange Rates'!$B$6*I2,0)"
Range("N2").Select
Range("N2").AutoFill Destination:=Range("N2:N1000" & Cells(Rows.Count, "D").End(xlUp).Row)
'EUR IT Currency Conversion
Range("O2").Select
ActiveCell.Formula = "=IF(G2=""IT"",'Exchange Rates'!$B$7*I2,0)"
Range("O2").Select
Range("O2").AutoFill Destination:=Range("O2:O1000" & Cells(Rows.Count, "D").End(xlUp).Row)
'EUR ES Currency Converter
Range("P2").Select
ActiveCell.Formula = "=IF(G2=""ES"",'Exchange Rates'!$B$8*I2,0)"
Range("P2").Select
Range("P2").AutoFill Destination:=Range("P2:P1000" & Cells(Rows.Count, "D").End(xlUp).Row)
'EUR FR Currency Conversion
Range("Q2").Select
ActiveCell.Formula = "=IF(G2=""FR"",'Exchange Rates'!$B$9*I2,0)"
Range("Q2").Select
Range("Q2").AutoFill Destination:=Range("Q2:Q1000" & Cells(Rows.Count, "D").End(xlUp).Row)
'EUR NL Currency Conversion
Range("R2").Select
ActiveCell.Formula = "=IF(G2=""NL"",'Exchange Rates'!$B$10*I2,0)"
Range("R2").Select
Range("R2").AutoFill Destination:=Range("R2:R1000" & Cells(Rows.Count, "D").End(xlUp).Row)
'INR Currency Conversion
Range("S2").Select
ActiveCell.Formula = "=IF(G2=""IN"",'Exchange Rates'!$B$11*I2,0)"
Range("S2").Select
Range("S2").AutoFill Destination:=Range("S2:S1000" & Cells(Rows.Count, "D").End(xlUp).Row)
'AUD Currency Conversion
Range("T2").Select
ActiveCell.Formula = "=IF(G2=""AU"",'Exchange Rates'!$B$12*I2,0)"
Range("T2").Select
Range("T2").AutoFill Destination:=Range("T2:T1000" & Cells(Rows.Count, "D").End(xlUp).Row)
'BRL Currency Conversion
Range("U2").Select
ActiveCell.Formula = "=IF(G2=""BR"",'Exchange Rates'!$B$13*I2,0)"
Range("U2").Select
Range("U2").AutoFill Destination:=Range("U2:U1000" & Cells(Rows.Count, "D").End(xlUp).Row)
'MXN Currency Conversion
Range("V2").Select
ActiveCell.Formula = "=IF(G2=""MX"",'Exchange Rates'!$B$14*I2,0)"
Range("V2").Select
Range("V2").AutoFill Destination:=Range("V2:V1000" & Cells(Rows.Count, "D").End(xlUp).Row)
'USD Currency Conversion
Range("W2").Select
ActiveCell.Formula = "=IF(G2=""US"",'Exchange Rates'!$B$2*I2,0)"
Range("W2").Select
Range("W2").AutoFill Destination:=Range("W2:W1000" & Cells(Rows.Count, "D").End(xlUp).Row)
'Find and Replace illegal characters
Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long
fndList = Array("N/A", "Amazon.com.au", "Amazon.com.br", "Amazon.com.mx", "Amazon.com", "Amazon.co.uk", "Amazon.co.jp", "Amazon.ca", "Amazon.it", "Amazon.fr", "Amazon.es", "Amazon.nl", "Amazon.in", "Amazon.de")
rplcList = Array("0", "AU", "BR", "MX", "US", "UK", "JP", "CA", "IT", "FR", "ES", "NL", "IN", "DE")
'Loop through each item in Array lists
For x = LBound(fndList) To UBound(fndList)
'Loop through each worksheet in ActiveWorkbook
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
Next x
'Royalty Month autofill
'Get filename
Range("AH2") = "=MID(CELL(""filename""),SEARCH(""["",CELL(""filename""))+1, SEARCH(""]"",CELL(""filename""))-SEARCH(""["",CELL(""filename""))-1)"
Range("AH2").Select
Selection.Copy
Range("AI2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AJ2").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-1],27,4)"
Range("AJ2").Select
Selection.Copy
Range("C2:C1000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'RoyaltyYear Autofill
Range("AK2").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-2],32,2)"
Range("AK2").Select
Selection.Copy
Range("B2:B1000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Retailer Column Autofill
Range("A2").Select
ActiveCell.FormulaR1C1 = "Kindle Unlimited"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A1000"), Type:=xlFillDefault
Range("A2").Select
'Delete unnecessary cells
Range("AH2:AK2").Select
Selection.ClearContents
'Final Cleanup work
Columns("K:K").Select
Selection.ColumnWidth = 22.57
Columns("L:W").Select
Selection.NumberFormat = "$#,##0.00"
Columns("K:K").Select
Selection.Style = "Currency"
Selection.NumberFormat = "$#,##0.00"
Range("W2").Select
Range("X2").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-13]:RC[-1])"
Range("X2").Select
Selection.AutoFill Destination:=Range("X2:X48"), Type:=xlFillDefault
Range("X2:X48").Select
Range("Y2").Select
ActiveCell.FormulaR1C1 = "USD"
Range("Y2").Select
Selection.AutoFill Destination:=Range("Y2:Y48"), Type:=xlFillDefault
Columns("K:W").Select
Selection.EntireColumn.Hidden = True
'Delete empty rows in Retailer Column if Title Column is blank
On Error Resume Next
Columns("D").SpecialCells(xlBlanks).EntireRow.Delete
'Delete Adjusted Currency Column as no longer needed
Columns("AG:AG").Select
Selection.Delete Shift:=xlToLeft
'Format KENP column as General text
Columns("H").Select
Selection.NumberFormat = "General"
'Save as CSV to directory
'ActiveWorkbook.SaveAs FileName:= _
'"C:\Royalties\KDP\KDP.csv", FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = False
Dim fn As String
Dim l As Long
Dim wb As Workbook
Set wb = ActiveWorkbook
fn = wb.FullName
l = InStrRev(fn, ".")
fn = Left(fn, l)
fn = fn & "csv"
wb.SaveAs fileName:=fn, FileFormat:=xlCSV
Application.DisplayAlerts = False
Range("A2").Select
End Sub

Answer 1

Here are two advices:
1: The comment from barvobot is a good approach:
Add the following code at the beginn of your sub to deactivate calculation and screen updating:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
At the end of your sub activate the calculation and screen updating again:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
This will make your code faster.
2: You are working a lot with .select. I think this is not a good approach. Here is my suggestion:
Use a Worksheet-variable for your new sheet. So replace your code:
'Add New sheet for marketplace and currency conversions
Sheets.Add After:=ActiveSheet
Sheets("Sheet1").Name = "Exchange Rates"
Range("A1").Select
with:
Dim ws As Worksheet
Set ws = Sheets.Add(After:=ActiveSheet)
ws.Name = "Exchange Rates"
Use the Worksheet-variable to set values and replace the .select. Here is an example:
replace:
Range("A2").Select
ActiveCell.FormulaR1C1 = "US"
Range("B2").Select
ActiveCell.FormulaR1C1 = "1"
Range("A3").Select
ActiveCell.FormulaR1C1 = "UK"
with:
ws.Range("A2").value = "US"
ws.Range("B2").value = "1"
ws.Range("A3").value = "UK"
This will reduce your code enormously.