CODEWITHSUNDEEP
vbaexcel
Cory Gabba
Cory Gabba

Reputation: 25

I want to make my current macro only run on the specific row that is changed

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

Upvotes: 1

Views: 1105

Answers (1)

Chrismas007
Chrismas007

Reputation: 6105

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.

Upvotes: 1

Related Questions