Hi everyone,
I'm not an expert at VBA and normally use codes written by others online/ in this forum. I have the following macro for my workbook and I will execute this every time I paste new data into my workbook.
The problem is, the data involved is big and can be up to 90000+ rows. The file is around 20Mb and so far, I still don't know how long this macro will take me. Everytime I automate the macro, excel stops responding.
I hope for someone to help me shorten/ speed up the macro if possible!
I'm not an expert at VBA and normally use codes written by others online/ in this forum. I have the following macro for my workbook and I will execute this every time I paste new data into my workbook.
The problem is, the data involved is big and can be up to 90000+ rows. The file is around 20Mb and so far, I still don't know how long this macro will take me. Everytime I automate the macro, excel stops responding.
I hope for someone to help me shorten/ speed up the macro if possible!
Code:
Sub APAC()
Application.ScreenUpdating = False
Application.Cursor = xlWait
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
'Delete rows which contain blank cells in column E
Sheets("Data").Select
On Error Resume Next
Range("E1:E100000").Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
' Replace countries with short notations
Columns("C:C").Select
Selection.Replace What:="Australia", Replacement:="AUS", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="CHINA", Replacement:="CHN", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="HONG KONG", Replacement:="HKG", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Indonesia Distrib.", Replacement:="IDN", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="JAPAN", Replacement:="JPN", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="KOREA", Replacement:="KOR", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="MyanmarCambodiaLaos", Replacement:="MCL", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Malaysia", Replacement:="MYS", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="New Zealand", Replacement:="NZL", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="PHILIPPINES", Replacement:="PHL", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="SINGAPORE", Replacement:="SGP", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="TAIWAN", Replacement:="TWN", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="THAILAND", Replacement:="THA", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="VIETNAM", Replacement:="VNM", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Sort Data into CN, Active, Basic
ActiveSheet.Range("$A$1:$X$92077").AutoFilter Field:=5, Criteria1:="BASIC"
ActiveSheet.Range("$A$1:$X$92077").AutoFilter Field:=13, Criteria1:="CN"
ActiveSheet.Range("$A$1:$X$92077").AutoFilter Field:=14, Criteria1:= _
"Active"
'Sort Data by ascending profits
ActiveWorkbook.Worksheets("Data").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Data").AutoFilter.Sort.SortFields.Add Key _
:=Range("R1:R92077"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Data").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Data").Range("A:R").Copy Destination:=Sheets("Target").Range("A:R")
'Clear columns S to V
Columns("S:V").Select
Selection.ClearContents
'Input curve formulas
Sheets("Target").Select
Range("S1").Value = "%"
Range("S2").Value = "=IF(COUNT(R2C15:RC15)<R4C25,""10%"",IF(COUNT(R2C15:RC15)<R7C25,""20%"",IF(COUNT(R2C15:RC15)<R10C25, ""30%"",0)))"
Range("T2").Value = "1"
Range("U1").Value = "%"
Range("U2").Value = "=RC[-1]/COUNT(C[-6])"
Range("V1").Value = "Cumulative Profit %"
Range("V2").Value = "=SUM(R2C[-4]:RC18)/R3C24"
'Autofill columns S to V, using column R as a ref
Sheets("Target").Select
Range("S2:V2").AutoFill Destination:=Range("S2:V" & Range("R" & Rows.Count).End(xlUp).Row)
'Refresh all pivot tables
ActiveWorkbook.RefreshAll
Sheets("Summary").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.Cursor = xlDefault
Application.DisplayAlerts = True
End Sub