undo VBA procedure error when called via change event
 

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

undo VBA procedure error when called via change event
 

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

undo VBA procedure error when called via change event
 

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

undo VBA procedure error when called via change event
 

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

undo VBA procedure error when called via change event
 

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

undo VBA procedure error when called via change event
 

Hi Dave,

Your code changes work great via the change worksheet event,

but one of the problems I have now is that when I have text in a cell and
it is then deleted, which activates the change event procedure and the
formula is inserted - which is how I won't it to work. If I then go to undo
the procedure the code works but because the last event was to insert the
formula, all that is undone is the insert formula so I am still left with a
blank cell.

Is it possible to set up the formula so that it can undo back 2 steps so
that the text deletion could then be undone as well???

Thanks for your help

"Dave Peterson" wrote:

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

undo VBA procedure error when called via change event
 

If it's stuff you do in code, you'll have to do the same kind of thing. Keep
track of the address, value and worksheet in a different procedure (similar to
SaveUndoStack). And make a new version of the UndoZero that restores things.

I would have put those type's, public declarations and subroutines in a
dedicated module.

Now I would change these two lines:

Public OldSheet As Worksheet
Public OldRng() As SaveRange
to
Dim OldSheet As Worksheet
Dim OldRng() As SaveRange

So that they're only visible by the procedures in this module.

And move this portion to its own general module:
Type SaveRange
Val As Variant
Addr As String
End Type


Then create a new module with the same code. But change the names of the
procedures so that each is unique.

And remember to change this:
Application.OnUndo "Undo the ZeroRange macro", "UndoZero"
to the new name and a new description.


And you should be pretty far on your way.


bradmcq wrote:

Hi Dave,

Your code changes work great via the change worksheet event,

but one of the problems I have now is that when I have text in a cell and
it is then deleted, which activates the change event procedure and the
formula is inserted - which is how I won't it to work. If I then go to undo
the procedure the code works but because the last event was to insert the
formula, all that is undone is the insert formula so I am still left with a
blank cell.

Is it possible to set up the formula so that it can undo back 2 steps so
that the text deletion could then be undone as well???

Thanks for your help

"Dave Peterson" wrote:

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


--

Dave Peterson

undo VBA procedure error when called via change event
 

Hi Dave,

The deletion of text wouldn't be done via code it would be via a worksheet
user deleting the text in the cell. I assume then that, because executing
the code postthe key strock clears the undo memory in excel then I wouldn't
be able to retrieve it??

Would a solution be to include a prompt for users via a yes/no box if they
attempt to delete text from cells within the range and if yes the delete
continues and if no the delete command is stopped?

If this weas a solution where should I position it in the code

Your help is much appreciated, am just a beginner at VBA, trying to find me
feet

Thanks


"Dave Peterson" wrote:

If it's stuff you do in code, you'll have to do the same kind of thing. Keep
track of the address, value and worksheet in a different procedure (similar to
SaveUndoStack). And make a new version of the UndoZero that restores things.

I would have put those type's, public declarations and subroutines in a
dedicated module.

Now I would change these two lines:

Public OldSheet As Worksheet
Public OldRng() As SaveRange
to
Dim OldSheet As Worksheet
Dim OldRng() As SaveRange

So that they're only visible by the procedures in this module.

And move this portion to its own general module:
Type SaveRange
Val As Variant
Addr As String
End Type


Then create a new module with the same code. But change the names of the
procedures so that each is unique.

And remember to change this:
Application.OnUndo "Undo the ZeroRange macro", "UndoZero"
to the new name and a new description.


And you should be pretty far on your way.


bradmcq wrote:

Hi Dave,

Your code changes work great via the change worksheet event,

but one of the problems I have now is that when I have text in a cell and
it is then deleted, which activates the change event procedure and the
formula is inserted - which is how I won't it to work. If I then go to undo
the procedure the code works but because the last event was to insert the
formula, all that is undone is the insert formula so I am still left with a
blank cell.

Is it possible to set up the formula so that it can undo back 2 steps so
that the text deletion could then be undone as well???

Thanks for your help

"Dave Peterson" wrote:

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


--

Dave Peterson

undo VBA procedure error when called via change event
 

I'm not quite sure I understand. Are you tying into the worksheet_change event
again?

If no, then the prompt for the yes/no before they do the work would have to be
based on the worksheet_Selection change.

There is no event for the next possible change.



bradmcq wrote:

Hi Dave,

The deletion of text wouldn't be done via code it would be via a worksheet
user deleting the text in the cell. I assume then that, because executing
the code postthe key strock clears the undo memory in excel then I wouldn't
be able to retrieve it??

Would a solution be to include a prompt for users via a yes/no box if they
attempt to delete text from cells within the range and if yes the delete
continues and if no the delete command is stopped?

If this weas a solution where should I position it in the code

Your help is much appreciated, am just a beginner at VBA, trying to find me
feet

Thanks

"Dave Peterson" wrote:

If it's stuff you do in code, you'll have to do the same kind of thing. Keep
track of the address, value and worksheet in a different procedure (similar to
SaveUndoStack). And make a new version of the UndoZero that restores things.

I would have put those type's, public declarations and subroutines in a
dedicated module.

Now I would change these two lines:

Public OldSheet As Worksheet
Public OldRng() As SaveRange
to
Dim OldSheet As Worksheet
Dim OldRng() As SaveRange

So that they're only visible by the procedures in this module.

And move this portion to its own general module:
Type SaveRange
Val As Variant
Addr As String
End Type


Then create a new module with the same code. But change the names of the
procedures so that each is unique.

And remember to change this:
Application.OnUndo "Undo the ZeroRange macro", "UndoZero"
to the new name and a new description.


And you should be pretty far on your way.


bradmcq wrote:

Hi Dave,

Your code changes work great via the change worksheet event,

but one of the problems I have now is that when I have text in a cell and
it is then deleted, which activates the change event procedure and the
formula is inserted - which is how I won't it to work. If I then go to undo
the procedure the code works but because the last event was to insert the
formula, all that is undone is the insert formula so I am still left with a
blank cell.

Is it possible to set up the formula so that it can undo back 2 steps so
that the text deletion could then be undone as well???

Thanks for your help

"Dave Peterson" wrote:

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


--

Dave Peterson


--

Dave Peterson