Macron running extremely slow after update to Excel 2016

Hi

I have previously run Excel 2010. After update to Excel 2016 macros runinng extremly slow. Does any one know why?

Below is my code. Its runs thousands of rows of input data through a recipe database and throws out the components in a output sheet. in Excel 2010 it run through 100 rows/s in Excel 2016 the same number is 2 rows/s. The input data is 18000 rows. So macro time has increased from 3 minutes to 2,5 hours.

Sub DM_Krunch()

'************************************************************

'Define variables used in the Macro

Dim LiftYear As String
Dim LiftMonth As String
Dim SalesRegionName As String
Dim SalesChannelName As String
Dim SalesManager As String  'new
Dim ShipToNr As String
Dim ShipToShortName As String
Dim SupplyPriorityClass As String
Dim ShipToCustomerSubsegmentLongName As String
Dim CentralAgreementName As String
Dim ShipToCountryCode As String
Dim BillToNr As String
Dim ShortItemNr As String
Dim ItemName As String
Dim PackingCode As String
Dim CorrespBulkShortItemNr As Integer
Dim CorrespBulkItemName As String
Dim ProductGroupName As String
Dim CorrespOriginalShortItemNr As Integer
Dim CorrespOriginalItemName As String
Dim DepotNr As String
Dim BranchplantNr As String
Dim DepotName As String
Dim SecondaryDistrCost As Single
Dim NetbackSupply As Single
Dim NetbackDepot As Single
Dim Revenue As Single
Dim QuantityTon As Single
Dim BlendedIn As String
Dim Radirecept As Integer
Dim i As Single
Dim j As Integer
Dim AntalCrunchRader As Single
Dim Rad_i_output As Single
    
'*************************************************************

Application.ScreenUpdating = False

'*************************************************************

'Find out number rows in Input (i.e. nr of loopes required)

Sheets("Input").Select
Range("A1").Select
AntalCrunchRader = Selection.End(xlDown).Row

'*************************************************************

'Empty old content in Output

Sheets("Output").Select
Range("A3:AI3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

'*************************************************************
   
'Pick each row in Input, run it through Recipe and throw it out in Output
For i = 2 To AntalCrunchRader
        
Sheets("Input").Select
        
LiftYear = Cells(i, 1)
LiftMonth = Cells(i, 2)
SalesRegionName = Cells(i, 3)
SalesChannelName = Cells(i, 4)
SalesManager = Cells(i, 5)
ShipToNr = Cells(i, 6)
ShipToShortName = Cells(i, 7)
SupplyPriorityClass = Cells(i, 8)
CustomerSegment = Cells(i, 9)
ShipToCustomerSubsegmentNr = Cells(i, 10)
ShipToCustomerSubsegmentLongName = Cells(i, 11)
CentralAgreementName = Cells(i, 12)
ShipToCountryCode = Cells(i, 13)
BillToNr = Cells(i, 14)
ShortItemNr = Cells(i, 15)
ItemName = Cells(i, 16)
PackingCode = Cells(i, 17)
CorrespBulkShortItemNr = Cells(i, 18)
CorrespBulkItemName = Cells(i, 19)
ProductGroupName = Cells(i, 20)
CorrespOriginalShortItemNr = Cells(i, 21)
CorrespOriginalItemName = Cells(i, 22)
DepotNr = Cells(i, 23)
BranchplantNr = Cells(i, 24)
DepotName = Cells(i, 25)
ModeOfTransport = Cells(i, 26)
SecondaryDistrCost = Cells(i, 27)
NetbackDepot = Cells(i, 28)
NetbackSupply = Cells(i, 29)
Revenue = Cells(i, 30)
QuantityTon = Cells(i, 31)
BlendedIn = Cells(i, 33)

 
   Excel.ActiveWorkbook.Application.StatusBar = "Crunching row: " & i & _
   " (" & CorrespBulkItemName & " at " & DepotName & " )"
        
        On Error GoTo Feldepot
        Sheets("Recipe").Select
        Columns("A:A").Select
        Combination = CorrespOriginalShortItemNr & BlendedIn
        Radirecept = Selection.Find(Combination, LookAt:=xlWhole, LookIn:=xlValues).Row
            
            For j = 1 To 7
            
            Sheets("Recipe").Select
            If Cells(Radirecept + j - 1, 1) = Combination Then
            RefineryOilNr = Cells(Radirecept + j - 1, 9)
            RefineryOilName = Cells(Radirecept + j - 1, 8)
            StoredOilNr = Cells(Radirecept + j - 1, 11)
            StoredOilName = Cells(Radirecept + j - 1, 10)
            Crunchvolume = Cells(Radirecept + j - 1, 7) * QuantityTon
            CrunchSecondaryDistrCost = Cells(Radirecept + j - 1, 7) * SecondaryDistrCost
            CrunchNetbackDepot = Cells(Radirecept + j - 1, 7) * NetbackDepot
            CrunchNetbackSupply = Cells(Radirecept + j - 1, 7) * NetbackSupply
            CrunchRevenue = Cells(Radirecept + j - 1, 7) * Revenue
            'ViscInterval = Cells(Radirecept + j - 1, 17)
            
            Sheets("Output").Select
            Range("B1").Select
            Rad_i_output = Selection.End(xlDown).Offset(1, 0).Row
            
            Cells(Rad_i_output, 1) = LiftYear
            Cells(Rad_i_output, 2) = LiftMonth
            Cells(Rad_i_output, 3) = SalesRegionName
            Cells(Rad_i_output, 4) = SalesChannelName
            Cells(Rad_i_output, 5) = SalesManager
            Cells(Rad_i_output, 6) = ShipToNr
            Cells(Rad_i_output, 7) = ShipToShortName
            Cells(Rad_i_output, 8) = SupplyPriorityClass
            Cells(Rad_i_output, 9) = CustomerSegment
            Cells(Rad_i_output, 10) = ShipToCustomerSubsegmentNr
            Cells(Rad_i_output, 11) = ShipToCustomerSubsegmentLongName
            Cells(Rad_i_output, 12) = CentralAgreementName
            Cells(Rad_i_output, 13) = ShipToCountryCode
            Cells(Rad_i_output, 14) = BillToNr
            Cells(Rad_i_output, 15) = ShortItemNr
            Cells(Rad_i_output, 16) = ItemName
            Cells(Rad_i_output, 17) = PackingCode
            Cells(Rad_i_output, 18) = CorrespBulkShortItemNr
            Cells(Rad_i_output, 19) = CorrespBulkItemName
            Cells(Rad_i_output, 20) = ProductGroupName
            Cells(Rad_i_output, 21) = CorrespOriginalShortItemNr
            Cells(Rad_i_output, 22) = CorrespOriginalItemName
            Cells(Rad_i_output, 23) = StoredOilNr
            Cells(Rad_i_output, 24) = StoredOilName
            Cells(Rad_i_output, 25) = RefineryOilNr
            Cells(Rad_i_output, 26) = RefineryOilName
            Cells(Rad_i_output, 27) = DepotNr
            Cells(Rad_i_output, 28) = BranchplantNr
            Cells(Rad_i_output, 29) = DepotName
            Cells(Rad_i_output, 30) = ModeOfTransport
            Cells(Rad_i_output, 31) = CrunchSecondaryDistrCost
            Cells(Rad_i_output, 32) = CrunchNetbackDepot
            Cells(Rad_i_output, 33) = CrunchNetbackSupply
            Cells(Rad_i_output, 34) = CrunchRevenue
            Cells(Rad_i_output, 35) = Crunchvolume
            'Cells(Rad_i_output, 36) = ViscInterval
            
            End If
            Next j
HoppaOver:
    Next i
    

Feldepot:
    If i < AntalCrunchRader Then
    MsgBox ("Error crunching row " & i & ". " & Chr(13) & "Can not find product " & CorrespOriginalShortItemNr & "-" & CorrespOriginalItemName & " in recipe " & BlendedIn)
    Else
    MsgBox ("Crunch finished after " & i - 1 & " rows.")
    End If
    
Application.ScreenUpdating = True

End Sub

I have searched the internet, looking for people with the same kind of problem - and there is but I find no solutions?

Any ideas??

Many many thanks
//Martin