K
ker_01
I have a data validation list on Sheet1. I have code that needs to trigger
each time that cell selection is changed. No problem so far.
When the value changes, I use that value to find corresponding records on
sheet3, and copy them into Sheet1 in the desired columns.
The base code seems to run pretty fast (when I run with breakpoints), but
when I run the whole thing, the machine locks up and I get an 'out of memory'
error. Is suspect it is because each time I paste in a cell value, this same
sub (worksheet_change) is retriggered. Is there a way to temporarily block
worksheet_change from even being triggered until my sub is complete?
Thank you,
Keith
Private Sub Worksheet_Change(ByVal Target As Range)
Application.Calculation = xlCalculationManual
If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
If Target = Sheet1.Range("F1") Then
SelectedOwner = Target.Value
LastSourceRow = lastRow(Sheet3) 'separate function, returns 397
PasteRow = 6
For I = 2 To LastSourceRow '397
If Sheet3.Range("AF" & I).Value = SelectedOwner Then
PasteRow = PasteRow + 1
Sheet1.Range("A" & PasteRow).Value = Sheet3.Range("A" &
I).Value
Sheet1.Range("B" & PasteRow).Value = Sheet3.Range("X" &
I).Value
Sheet1.Range("C" & PasteRow).Value = Sheet3.Range("Y" &
I).Value
Sheet1.Range("D" & PasteRow).Value = Sheet3.Range("Z" &
I).Value
Sheet1.Range("E" & PasteRow).Value = Sheet3.Range("AA" &
I).Value
Sheet1.Range("F" & PasteRow).Value = Sheet3.Range("U" &
I).Value
Sheet1.Range("G" & PasteRow).Value = Sheet3.Range("B" &
I).Value
Sheet1.Range("H" & PasteRow).Value = Sheet3.Range("C" &
I).Value
Sheet1.Range("I" & PasteRow).Value = Sheet3.Range("E" &
I).Value
Sheet1.Range("J" & PasteRow).Value = Sheet3.Range("F" &
I).Value
Sheet1.Range("K" & PasteRow).Value = Sheet3.Range("G" &
I).Value
Sheet1.Range("P" & PasteRow).Value = Sheet3.Range("N" &
I).Value
Sheet1.Range("Q" & PasteRow).Value = Sheet3.Range("O" &
I).Value
Sheet1.Range("R" & PasteRow).Value = Sheet3.Range("P" &
I).Value
Sheet1.Range("S" & PasteRow).Value = Sheet3.Range("J" &
I).Value
Sheet1.Range("T" & PasteRow).Value = Sheet3.Range("H" &
I).Value
End If
Next
Application.Calculation = xlCalculationAutomatic
End If
End If
End Sub
each time that cell selection is changed. No problem so far.
When the value changes, I use that value to find corresponding records on
sheet3, and copy them into Sheet1 in the desired columns.
The base code seems to run pretty fast (when I run with breakpoints), but
when I run the whole thing, the machine locks up and I get an 'out of memory'
error. Is suspect it is because each time I paste in a cell value, this same
sub (worksheet_change) is retriggered. Is there a way to temporarily block
worksheet_change from even being triggered until my sub is complete?
Thank you,
Keith
Private Sub Worksheet_Change(ByVal Target As Range)
Application.Calculation = xlCalculationManual
If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
If Target = Sheet1.Range("F1") Then
SelectedOwner = Target.Value
LastSourceRow = lastRow(Sheet3) 'separate function, returns 397
PasteRow = 6
For I = 2 To LastSourceRow '397
If Sheet3.Range("AF" & I).Value = SelectedOwner Then
PasteRow = PasteRow + 1
Sheet1.Range("A" & PasteRow).Value = Sheet3.Range("A" &
I).Value
Sheet1.Range("B" & PasteRow).Value = Sheet3.Range("X" &
I).Value
Sheet1.Range("C" & PasteRow).Value = Sheet3.Range("Y" &
I).Value
Sheet1.Range("D" & PasteRow).Value = Sheet3.Range("Z" &
I).Value
Sheet1.Range("E" & PasteRow).Value = Sheet3.Range("AA" &
I).Value
Sheet1.Range("F" & PasteRow).Value = Sheet3.Range("U" &
I).Value
Sheet1.Range("G" & PasteRow).Value = Sheet3.Range("B" &
I).Value
Sheet1.Range("H" & PasteRow).Value = Sheet3.Range("C" &
I).Value
Sheet1.Range("I" & PasteRow).Value = Sheet3.Range("E" &
I).Value
Sheet1.Range("J" & PasteRow).Value = Sheet3.Range("F" &
I).Value
Sheet1.Range("K" & PasteRow).Value = Sheet3.Range("G" &
I).Value
Sheet1.Range("P" & PasteRow).Value = Sheet3.Range("N" &
I).Value
Sheet1.Range("Q" & PasteRow).Value = Sheet3.Range("O" &
I).Value
Sheet1.Range("R" & PasteRow).Value = Sheet3.Range("P" &
I).Value
Sheet1.Range("S" & PasteRow).Value = Sheet3.Range("J" &
I).Value
Sheet1.Range("T" & PasteRow).Value = Sheet3.Range("H" &
I).Value
End If
Next
Application.Calculation = xlCalculationAutomatic
End If
End If
End Sub