help needed to speed up macro

[peltron]

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!

Sub APAC()
    Application.ScreenUpdating = False
    Application.Cursor = xlWait
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
   
    Sheets("Data").Select
    On Error Resume Next
    Range("E1:E100000").Select
    Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

    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
    
 
    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"

    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")

    Columns("S:V").Select
    Selection.ClearContents
     

    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"

    Sheets("Target").Select
    Range("S2:V2").AutoFill Destination:=Range("S2:V" & Range("R" & Rows.Count).End(xlUp).Row)

    ActiveWorkbook.RefreshAll
    
    Sheets("Summary").Select

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault
    Application.DisplayAlerts = True


    End Sub

</r4c25,""10%"",if(count(r2c15:rc15)<r7c25,""20%"",if(count(r2c15:rc15)<r10c25,>

 

[peltron]

Code continue - I don't know why the code got cut off

 Range("T2").Value = "1"    Range("U1").Value = "SKU %"
    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 SKUs").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

 

[pvr928]

Hi peltron

I haven't spent a lot of time digesting your code, but at first glance it looks like your data range is likely A1:V100000 or thereabouts.

That is 2,200,000 cells. I don't know the makeup of the cells up to column T, but columns S - V look like they're populated with formulae.

If there is a surefire way to slow Excel down, it is to use an excessive number of formulae. Some are worse than others, but after a point, too many of any formulae will slow Excel down. If you have formulae in columns up to S as well (and all the way down to row 100,000) this will make things even worse.

If you want to speed things up, you need to think how to replace the function of worksheet formulae with something else. VBA can easily do this, but we'll need more information on the makeup of you spreadsheet in order to help.

pvr928