Excel Slow performance

[Paul_Hossler]

I'd do it each day, or at least in batchs


In the attachment, for the rows that are in the Selection, L - AB will be computed when you run the macro after you put in values for A - K


Example --

Select A8 - A11 and run the macro

This will re-compute any previous row, so unless the data's changed, it's faster to just select rows with new data entered

Option Explicit


Sub AddData()
    Dim rData As Range, rRow As Range, rDates As Range, rNames As Range, rSkills As Range
    Dim i As Long
    If Not TypeOf Selection Is Range Then Exit Sub
        
    Set rData = Worksheets("Data").Range("A1").CurrentRegion
    Set rDates = Worksheets("Mapping").Range("I1").CurrentRegion
    Set rNames = Worksheets("Mapping").Range("A1").CurrentRegion
    Set rNames = rNames.Cells(1, 2).Resize(rNames.Rows.Count, rNames.Columns.Count - 1) ' emp number is in A
    Set rSkills = Worksheets("Mapping").Range("P1").CurrentRegion
    
    Application.ScreenUpdating = False
    
    For Each rRow In Intersect(Selection.EntireRow, rData).Rows
        With rRow
            If .Row = 1 Then GoTo GetNext
            If Len(.Cells(1).Value) = 0 Then GoTo GetNext
            
            For i = 12 To 21
                .Cells(i).Value = "-"
            Next I
              
            On Error Resume Next
            .Cells(12).Value = Format(.Cells(2).Value, "DDDD")
            .Cells(13).Value = Format(.Cells(2).Value, "MMM-YY")
            .Cells(14).Value = "WK" & Application.WorksheetFunction.WeekNum(.Cells(2).Value)
            .Cells(15).Value = Application.WorksheetFunction.VLookup(CLng(.Cells(2).Value), rDates, 5, False)
            .Cells(16).Value = Application.WorksheetFunction.VLookup(CLng(.Cells(2).Value), rDates, 6, False)
        
            .Cells(17).Value = Application.WorksheetFunction.VLookup(.Cells(3).Value, rNames, 2, False)
            .Cells(18).Value = Application.WorksheetFunction.VLookup(.Cells(3).Value, rNames, 4, False)
            .Cells(19).Value = Application.WorksheetFunction.VLookup(.Cells(3).Value, rNames, 5, False)
        
            .Cells(20).Value = Application.WorksheetFunction.VLookup(.Cells(1).Value, rSkills, 4, False)
            .Cells(21).Value = Application.WorksheetFunction.VLookup(.Cells(1).Value, rSkills, 5, False)
        
            .Cells(22).Value = .Cells(4).Value * .Cells(5).Value
            .Cells(23).Value = .Cells(4).Value * .Cells(6).Value
            .Cells(24).Value = .Cells(4).Value * .Cells(7).Value
            .Cells(25).Value = .Cells(4).Value * .Cells(8).Value
            .Cells(26).Value = .Cells(9).Value / 600
            .Cells(27).Value = .Cells(10).Value / 60
            .Cells(28).Value = .Cells(11).Value / 60
            On Error GoTo 0
        
        End With
GetNext:
    Next
    Application.ScreenUpdating = True

End Sub