Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Worksheet_Change Event after Pasting Entire Rows

Status
Not open for further replies.

rabley

Programmer
Jul 9, 2007
25
0
0
US
I'm working with the Worksheet_Change event for the first time. It works fine when individual cells are changed, recalculating all my relevant columns. Unfortunately, copy/pasting or deleting entire rows of cells will call the subroutine so many times that everything slows down to a crawl. I know it's just doing what I told it to - running the code every time a cell changes, for each of my many columns. But is there any way to detect when an entire row has changed at once and only call the code once per row?

Here is my code:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    
    Application.EnableEvents = False
    
    Dim FullCost As Range
    Dim OurCost As Range
    Dim perPackingUnit As Range
    Dim lastRow As Integer
    Dim packingUnit As Range
    Dim mWeight As Range
    Dim prodType As Range
    Dim rngCell As Range
    Dim oneToThreePrice As Range
    
    lastRow = ActiveSheet.UsedRange.Rows.Count
    Set FullCost = Range("DK4:DK" & lastRow)
    Set OurCost = Range("DM4:DM" & lastRow)
    Set perPackingUnit = Range("AA4:AA" & lastRow)
    Set packingUnit = Range("Z4:Z" & lastRow)
    Set mWeight = Range("T4:T" & lastRow)
    Set prodType = Range("I4:I" & lastRow)
    Set oneToThreePrice = Range("DP4:DP" & lastRow)
    
    
    If Not Application.Intersect(packingUnit, Range(Target.Address)) Is Nothing Then
        ' if packing unit has changed, need to clear irrelevant columns
        For Each rngCell In Target
        
            If Cells(rngCell.Row, 26).Value = "Carton" Then
                Cells(rngCell.Row, 123).Value = ""
            Else
                Cells(rngCell.Row, 120).Value = ""
                Cells(rngCell.Row, 121).Value = ""
                Cells(rngCell.Row, 122).Value = ""
                Cells(rngCell.Row, 124).Value = ""
            End If
            
            Call frmPricing.calculateColumns(rngCell.Row)
        Next
        
    ElseIf Not Application.Intersect(oneToThreePrice, Range(Target.Address)) Is Nothing Then
        ' no need to calculate earlier cells, just 121 and up
        Cells(Target.Row, 121).Value = Cells(Target.Row, 120).Value - 3
        Cells(Target.Row, 122).Value = Cells(Target.Row, 120).Value - 5
        Cells(Target.Row, 123).Value = ""

    ElseIf Not Application.Intersect(FullCost, Range(Target.Address)) Is Nothing _
        Or Not Application.Intersect(OurCost, Range(Target.Address)) Is Nothing _
        Or Not Application.Intersect(perPackingUnit, Range(Target.Address)) Is Nothing _
        Or Not Application.Intersect(mWeight, Range(Target.Address)) Is Nothing _
        Or Not Application.Intersect(prodType, Range(Target.Address)) Is Nothing Then

        Call frmPricing.calculateColumns(Target.Row)
        
    End If
    
    Application.EnableEvents = True
    
End Sub
 
You can:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count = Target.EntireRow.Cells.Count Then
    MsgBox "Row(s) deleted"
End If
End Sub


combo
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top