undo VBA procedure error when called via change event
in [Programming]
|
Prev: how to use modules so that values calculated in one of them can be used by another?
Next: Excel Table Width Pasted into Word
From: bradmcq on 17 Sep 2009 06:38 Hi I have the code below to insert a worksheet formula into cells within the range G24:G35 of the active sheet, and to allow the user to undo if the inadvertently delete the contents of a cell. Type SaveRange Val As Variant Addr As String End Type Public OldWorkbook As Workbook Public OldSheet As Worksheet Public OldSelection() As SaveRange Sub undoChange() If TypeName(Selection) <> "Range" Then Exit Sub ReDim OldSelection(Selection.Count) Set OldWorkbook = ActiveWorkbook Set OldSheet = ActiveSheet i = 0 For Each cell In Selection i = i + 1 OldSelection(i).Addr = cell.Address OldSelection(i).Val = cell.Formula Next cell Set r = Range("G24:G217") On Error Resume Next For Each cell In r If cell = 0 Then cell.FormulaR1C1 = "=IF(COUNTIF(Rc18:RC25,""Y"")>0,""Objective required"","""")" End If Next cell Application.OnUndo "Undo the ZeroRange macro", "UndoZero" End Sub Sub UndoZero() On Error GoTo Problem Application.ScreenUpdating = False OldWorkbook.Activate OldSheet.Activate For i = 1 To UBound(OldSelection) Range(OldSelection(i).Addr).Formula = OldSelection(i).Val Next i Exit Sub Problem: MsgBox "Can't undo" End Sub It seems to work if I run the macro by selecting the range G24:G35 and manually run the macro, but if I run it from an a worksheet_change event I get an error message related to the follownig line. ReDim OldSelection(Selection.Count) I can't work out why executing form the event handling of the sheet is a problem This is the chnage event code I am using Sub Worksheet_change(ByVal Target As Range) If Not Intersect(Target, Range("G24:G35")) Is Nothing Then Range("G24:G35").Select End If Call undoChange End Sub Any help would be much appreciated
From: Joel on 17 Sep 2009 08:33 try to reorder these statements from ReDim OldSelection(Selection.Count) Set OldWorkbook = ActiveWorkbook Set OldSheet = ActiveSheet to Set OldWorkbook = ActiveWorkbook Set OldSheet = ActiveSheet ReDim OldSelection(Selection.Count) "bradmcq" wrote: > Hi > I have the code below to insert a worksheet formula into cells within the > range G24:G35 of the active sheet, and to allow the user to undo if the > inadvertently delete the contents of a cell. > > Type SaveRange > Val As Variant > Addr As String > End Type > > > Public OldWorkbook As Workbook > Public OldSheet As Worksheet > Public OldSelection() As SaveRange > > > Sub undoChange() > > > > If TypeName(Selection) <> "Range" Then Exit Sub > > > ReDim OldSelection(Selection.Count) > Set OldWorkbook = ActiveWorkbook > Set OldSheet = ActiveSheet > i = 0 > For Each cell In Selection > i = i + 1 > OldSelection(i).Addr = cell.Address > OldSelection(i).Val = cell.Formula > Next cell > > > Set r = Range("G24:G217") > On Error Resume Next > For Each cell In r > If cell = 0 Then > cell.FormulaR1C1 = "=IF(COUNTIF(Rc18:RC25,""Y"")>0,""Objective > required"","""")" > > End If > Next cell > > > > Application.OnUndo "Undo the ZeroRange macro", "UndoZero" > End Sub > > > Sub UndoZero() > > On Error GoTo Problem > > Application.ScreenUpdating = False > > > OldWorkbook.Activate > OldSheet.Activate > > > For i = 1 To UBound(OldSelection) > Range(OldSelection(i).Addr).Formula = OldSelection(i).Val > Next i > Exit Sub > > > Problem: > MsgBox "Can't undo" > End Sub > > > It seems to work if I run the macro by selecting the range G24:G35 and > manually run the macro, but if I run it from an a worksheet_change event I > get an error message related to the follownig line. > > ReDim OldSelection(Selection.Count) > > I can't work out why executing form the event handling of the sheet is a > problem > > This is the chnage event code I am using > Sub Worksheet_change(ByVal Target As Range) > If Not Intersect(Target, Range("G24:G35")) Is Nothing Then > Range("G24:G35").Select > End If > Call undoChange > > End Sub > > Any help would be much appreciated > > >
From: bradmcq on 17 Sep 2009 16:39 Hi Joel, I changed the order but still get the same error. The error message I get is "the array is fixed or temporarily locked". I get this error message only if I try to use undo. One thought I had was that because I am trying to undo a cell within the range of my event handling procedure both the "undo change and undozero macro's are trying to run causing the problem??? thanks "Joel" wrote: > try to reorder these statements > > from > > ReDim OldSelection(Selection.Count) > Set OldWorkbook = ActiveWorkbook > Set OldSheet = ActiveSheet > > > to > > Set OldWorkbook = ActiveWorkbook > Set OldSheet = ActiveSheet > ReDim OldSelection(Selection.Count) > > > "bradmcq" wrote: > > > Hi > > I have the code below to insert a worksheet formula into cells within the > > range G24:G35 of the active sheet, and to allow the user to undo if the > > inadvertently delete the contents of a cell. > > > > Type SaveRange > > Val As Variant > > Addr As String > > End Type > > > > > > Public OldWorkbook As Workbook > > Public OldSheet As Worksheet > > Public OldSelection() As SaveRange > > > > > > Sub undoChange() > > > > > > > > If TypeName(Selection) <> "Range" Then Exit Sub > > > > > > ReDim OldSelection(Selection.Count) > > Set OldWorkbook = ActiveWorkbook > > Set OldSheet = ActiveSheet > > i = 0 > > For Each cell In Selection > > i = i + 1 > > OldSelection(i).Addr = cell.Address > > OldSelection(i).Val = cell.Formula > > Next cell > > > > > > Set r = Range("G24:G217") > > On Error Resume Next > > For Each cell In r > > If cell = 0 Then > > cell.FormulaR1C1 = "=IF(COUNTIF(Rc18:RC25,""Y"")>0,""Objective > > required"","""")" > > > > End If > > Next cell > > > > > > > > Application.OnUndo "Undo the ZeroRange macro", "UndoZero" > > End Sub > > > > > > Sub UndoZero() > > > > On Error GoTo Problem > > > > Application.ScreenUpdating = False > > > > > > OldWorkbook.Activate > > OldSheet.Activate > > > > > > For i = 1 To UBound(OldSelection) > > Range(OldSelection(i).Addr).Formula = OldSelection(i).Val > > Next i > > Exit Sub > > > > > > Problem: > > MsgBox "Can't undo" > > End Sub > > > > > > It seems to work if I run the macro by selecting the range G24:G35 and > > manually run the macro, but if I run it from an a worksheet_change event I > > get an error message related to the follownig line. > > > > ReDim OldSelection(Selection.Count) > > > > I can't work out why executing form the event handling of the sheet is a > > problem > > > > This is the chnage event code I am using > > Sub Worksheet_change(ByVal Target As Range) > > If Not Intersect(Target, Range("G24:G35")) Is Nothing Then > > Range("G24:G35").Select > > End If > > Call undoChange > > > > End Sub > > > > Any help would be much appreciated > > > > > >
From: Joel on 17 Sep 2009 18:20 I haven't use the undo a lot and don't know all the issues that can occur. "bradmcq" wrote: > Hi Joel, > > I changed the order but still get the same error. The error message I get > is "the array is fixed or temporarily locked". > > I get this error message only if I try to use undo. > > One thought I had was that because I am trying to undo a cell within the > range of my event handling procedure both the "undo change and undozero > macro's are trying to run causing the problem??? > > thanks > > "Joel" wrote: > > > try to reorder these statements > > > > from > > > > ReDim OldSelection(Selection.Count) > > Set OldWorkbook = ActiveWorkbook > > Set OldSheet = ActiveSheet > > > > > > to > > > > Set OldWorkbook = ActiveWorkbook > > Set OldSheet = ActiveSheet > > ReDim OldSelection(Selection.Count) > > > > > > "bradmcq" wrote: > > > > > Hi > > > I have the code below to insert a worksheet formula into cells within the > > > range G24:G35 of the active sheet, and to allow the user to undo if the > > > inadvertently delete the contents of a cell. > > > > > > Type SaveRange > > > Val As Variant > > > Addr As String > > > End Type > > > > > > > > > Public OldWorkbook As Workbook > > > Public OldSheet As Worksheet > > > Public OldSelection() As SaveRange > > > > > > > > > Sub undoChange() > > > > > > > > > > > > If TypeName(Selection) <> "Range" Then Exit Sub > > > > > > > > > ReDim OldSelection(Selection.Count) > > > Set OldWorkbook = ActiveWorkbook > > > Set OldSheet = ActiveSheet > > > i = 0 > > > For Each cell In Selection > > > i = i + 1 > > > OldSelection(i).Addr = cell.Address > > > OldSelection(i).Val = cell.Formula > > > Next cell > > > > > > > > > Set r = Range("G24:G217") > > > On Error Resume Next > > > For Each cell In r > > > If cell = 0 Then > > > cell.FormulaR1C1 = "=IF(COUNTIF(Rc18:RC25,""Y"")>0,""Objective > > > required"","""")" > > > > > > End If > > > Next cell > > > > > > > > > > > > Application.OnUndo "Undo the ZeroRange macro", "UndoZero" > > > End Sub > > > > > > > > > Sub UndoZero() > > > > > > On Error GoTo Problem > > > > > > Application.ScreenUpdating = False > > > > > > > > > OldWorkbook.Activate > > > OldSheet.Activate > > > > > > > > > For i = 1 To UBound(OldSelection) > > > Range(OldSelection(i).Addr).Formula = OldSelection(i).Val > > > Next i > > > Exit Sub > > > > > > > > > Problem: > > > MsgBox "Can't undo" > > > End Sub > > > > > > > > > It seems to work if I run the macro by selecting the range G24:G35 and > > > manually run the macro, but if I run it from an a worksheet_change event I > > > get an error message related to the follownig line. > > > > > > ReDim OldSelection(Selection.Count) > > > > > > I can't work out why executing form the event handling of the sheet is a > > > problem > > > > > > This is the chnage event code I am using > > > Sub Worksheet_change(ByVal Target As Range) > > > If Not Intersect(Target, Range("G24:G35")) Is Nothing Then > > > Range("G24:G35").Select > > > End If > > > Call undoChange > > > > > > End Sub > > > > > > Any help would be much appreciated > > > > > > > > >
From: Dave Peterson on 17 Sep 2009 19:20
I'm not sure how it's supposed to work, but I _think_ that this is ok. (I declared some variables and changed the names/procedures so that they made more sense to me. If you don't like the new names, you can change them back.) First, I changed the worksheet_change event to this: Option Explicit Sub Worksheet_change(ByVal Target As Range) Dim myRng As Range Set myRng = Me.Range("G24:G35") If Intersect(Target, myRng) Is Nothing Then 'do nothing Else Call SaveUndoStack(RngToSave:=myRng) End If End Sub I don't want to rely on the selection, so I wanted to pass the range to the SaveUndoStack procedure. And that meant that the procedure had to change. Option Explicit Public OldSheet As Worksheet Public OldRng() As SaveRange Type SaveRange Val As Variant Addr As String End Type Sub SaveUndoStack(RngToSave As Range) Dim myCell As Range Dim iCtr As Long Dim myFormulaRng As Range ReDim OldRng(1 To RngToSave.Cells.Count) Set OldSheet = RngToSave.Parent iCtr = 0 For Each myCell In RngToSave.Cells iCtr = iCtr + 1 OldRng(iCtr).Addr = myCell.Address OldRng(iCtr).Val = myCell.Formula Next myCell Set myFormulaRng = RngToSave.Parent.Range("G24:G217") On Error Resume Next Application.EnableEvents = False For Each myCell In myFormulaRng.Cells If myCell.Value = 0 Then myCell.FormulaR1C1 = "=IF(COUNTIF(Rc18:RC25,""Y"")>0," _ & """Objective required"","""")" End If Next myCell Application.EnableEvents = True Application.OnUndo "Undo the ZeroRange macro", "UndoZero" End Sub Sub UndoZero() Dim iCtr As Long On Error GoTo Problem: Application.ScreenUpdating = False Application.EnableEvents = False For iCtr = LBound(OldRng) To UBound(OldRng) OldSheet.Range(OldRng(iCtr).Addr).Formula = OldRng(iCtr).Val Next iCtr Application.EnableEvents = True Exit Sub Problem: MsgBox "Can't undo" End Sub bradmcq wrote: > > Hi > I have the code below to insert a worksheet formula into cells within the > range G24:G35 of the active sheet, and to allow the user to undo if the > inadvertently delete the contents of a cell. > > Type SaveRange > Val As Variant > Addr As String > End Type > > > Public OldWorkbook As Workbook > Public OldSheet As Worksheet > Public OldSelection() As SaveRange > > Sub undoChange() > > If TypeName(Selection) <> "Range" Then Exit Sub > > > ReDim OldSelection(Selection.Count) > Set OldWorkbook = ActiveWorkbook > Set OldSheet = ActiveSheet > i = 0 > For Each cell In Selection > i = i + 1 > OldSelection(i).Addr = cell.Address > OldSelection(i).Val = cell.Formula > Next cell > > > Set r = Range("G24:G217") > On Error Resume Next > For Each cell In r > If cell = 0 Then > cell.FormulaR1C1 = "=IF(COUNTIF(Rc18:RC25,""Y"")>0,""Objective > required"","""")" > > End If > Next cell > > > > Application.OnUndo "Undo the ZeroRange macro", "UndoZero" > End Sub > > Sub UndoZero() > > On Error GoTo Problem > > Application.ScreenUpdating = False > > > OldWorkbook.Activate > OldSheet.Activate > > > For i = 1 To UBound(OldSelection) > Range(OldSelection(i).Addr).Formula = OldSelection(i).Val > Next i > Exit Sub > > Problem: > MsgBox "Can't undo" > End Sub > > It seems to work if I run the macro by selecting the range G24:G35 and > manually run the macro, but if I run it from an a worksheet_change event I > get an error message related to the follownig line. > > ReDim OldSelection(Selection.Count) > > I can't work out why executing form the event handling of the sheet is a > problem > > This is the chnage event code I am using > Sub Worksheet_change(ByVal Target As Range) > If Not Intersect(Target, Range("G24:G35")) Is Nothing Then > Range("G24:G35").Select > End If > Call undoChange > > End Sub > > Any help would be much appreciated -- Dave Peterson |