1

I currently have this running piece of code that performs calculations on rows to the left and right of a cell in column M that has a specific value in it. I am using Data Validation on the column of cells to ensure the correct entry is selected. The issue is that right now the code takes far too long to run because it recalculates all the cells in a specified range each time a cell is changed. I would like it to only run on the row that was changed and not on any other cells. Any suggestions would be great :)

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim KeyCells As Range
    Set KeyCells = Range("$J$4", "$M$2000") 
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then 
    Dim x As Range
    Range("D2").Value = Environ("username")
    Range("B2") = Date
    For Each x In Range("$M$4", "$M$2000") 
    Select Case x.Value 
    Case "6 Realization": 
        x.Offset(0, 1).Value = 1 
        If x.Offset(0, -2) = "" Then 
            x.Offset(0, -1).Value = x.Offset(0, -3) - x.Offset(0, -2).Value ' 
        Else
            x.Offset(0, -1).Value = x.Offset(0, -2) - x.Offset(0, -3).Value 
        End If
    Case "7 Complete": 
        x.Offset(0, 1).Value = 1 
        If x.Offset(0, -2) = "" Then 
            x.Offset(0, -1).Value = x.Offset(0, -3) - x.Offset(0, -2).Value 
        Else
            x.Offset(0, -1).Value = x.Offset(0, -2) - x.Offset(0, -3).Value 
        End If
    Case "5 In Progress": 
        If x.Offset(0, -3).Value = "" Then 
            x.Offset(0, 1).Value = "" 
        Else
            x.Offset(0, 1).Value = (Date - (x.Offset(0, -3).Value)) / ((x.Offset(0, -2).Value) - (x.Offset(0, -3).Value)) 
    End If
        x.Offset(0, -1).Value = Date - x.Offset(0, -3).Value 
        If x.Offset(0, -2).Value = "" Then 
            x.Offset(0, 1).Value = "" 
        End If
    Case "4 Chartered": 
        x.Offset(0, 1).Value = ""
        x.Offset(0, -1).Value = Date - x.Offset(0, -3).Value
    Case "1 Ideas":
        x.Offset(0, 1).Value = ""
        x.Offset(0, -1).Value = Date - x.Offset(0, -3).Value
    Case "8 On Hold":
        x.Offset(0, 1).Value = ""
        x.Offset(0, -1).Value = Date - x.Offset(0, -3).Value
    Case "9 Terminated":
        x.Offset(0, 1).Value = ""
        If x.Offset(0, -2).Value = "" Then
            x.Offset(0, -1).Value = x.Offset(0, -3) - x.Offset(0, -2).Value
        Else
            x.Offset(0, -1).Value = x.Offset(0, -2) - x.Offset(0, -3).Value
        End If
    Case "2 OpID":
        x.Offset(0, 1).Value = ""
        x.Offset(0, -1).Value = Date - x.Offset(0, -3).Value
    End Select

    If x.Offset(0, -1).Value > 40000 Or x.Offset(0, -1).Value = 0 Then
        x.Offset(0, -1).Value = ""
    End If
    If x.Offset(0, 1).Value >= 1 Then
        x.Offset(0, 1).Value = 1
    End If
    If x.Offset(0, 1).Value < 0 Then
        x.Offset(0, 1).Value = 0
    End If
    Next
    End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Chrismas007
  • 6,085
  • 4
  • 24
  • 47
Cory Gabba
  • 25
  • 6
  • Have you tried putting `Application.Calculation = xlCalculationManual` at the beginning of your code and `Application.Calculation = xlCalculationAutomatic` at the end? – TheEngineer Dec 17 '14 at 14:00
  • Possible duplicate of [this.](http://stackoverflow.com/questions/1911490/excel-vba-recalculate-selection) – TheEngineer Dec 17 '14 at 14:02
  • I just did that and it improved the speed, so thank you for that! It still is calculating each row everytime any cell in the specified range is changed so I still have the same issue :( – Cory Gabba Dec 17 '14 at 14:07
  • Check the link I posted above. The accepted answer will let you recalculate only a specific range. – TheEngineer Dec 17 '14 at 14:11

1 Answers1

1

Leave Application.Calculation = xlCalculationManual and then use Range("Your range to recalculate").Calculate to just do that part. If you change the first part back to xlCalculationAutomatic then it will do your whole sheet again so just leave it as manual.

Chrismas007
  • 6,085
  • 4
  • 24
  • 47
  • I have tried adding this to the code and I think it will work, but I am unsure where to place it. I think the issue here is the for loop will run regardless and that needs to be changed to something else. Could I move the for loop chunk and make it its own sub and call that function if the specified cell is changed? – Cory Gabba Dec 17 '14 at 15:38
  • Your loop is defined by the range `x`. With reference to `x`, which cells need to be recalculated and where in the loop do they need to be recalculated? – Chrismas007 Dec 17 '14 at 23:22
  • Also it looks like you are subtracting dates. Does that code currently work? You might want to look into `DateDiff()` function. – Chrismas007 Dec 17 '14 at 23:26
  • the code currently works as it sits. I havent had any issues pop up yet that need to be addressed. I will look into the DateDiff() funtion and see if I can add that in place of using Date. The two cells that are calculated are one cell to the left x and one cell to the right of x. The calculations vary depending upon which value is in cell x (why case was used). – Cory Gabba Dec 18 '14 at 13:05
  • Do you only want to calculate for a given case? If so within the Case(s) that apply try: `Range(x.Offset(0,-1), x.Offset(0,1)).Calculate` – Chrismas007 Dec 18 '14 at 13:08