If you know that the style will always be calculation, you don't need to store
it.

Add a line under:
Range(OldSelection(i).Addr).Formula = OldSelection(i).Val
Range(OldSelection(i).Addr).style = "Calculation"

(untested)

If you were writing a generic Undo procedure, you'd have to keep track of the
style (or other formatting you want).



TKS_Mark wrote:

Mr. Peterson: As always, that was very helpful. I hate to push my luck, but
I have one more question.

I added...

Selection.Style = "Calculation"

just after the last End With. I guessed that I could store the previous
format using...

OldSelection(i).Val = cell.FormatConditions

inside the for-next loop and at undo restore the stored format by modifying
a line to...

Range(OldSelection(i).Addr).Formula.FormatConditio ns = OldSelection(i).Val

But Excel didn't like my first store statement.

Thanks!

"Dave Peterson" wrote:

Dim i as long
(since it's a counter of cells)

But you have other stuff to fix. John's code worked on the Selection. But you
want it to work on columns F:G and for as many rows as you had selected.

This seemed to work in light testing:

Option Explicit
'Custom data type for undoing
Type SaveRange
Val As Variant
Addr As String
End Type

' Stores info about current selection
Public OldWorkbook As Workbook
Public OldSheet As Worksheet
Public OldSelection() As SaveRange


Sub CopyFormula()

Dim myRngToCopy As Range
Dim myRng As Range
Dim i As Long
Dim cell As Range

' Abort if a range isn't selected
If TypeName(Selection) < "Range" Then Exit Sub

'single area at a time
Set myRng = Selection.Areas(1)
Set myRngToCopy = Intersect(myRng.EntireRow, _
ActiveSheet.Range("r1").EntireColumn)

ReDim OldSelection(myRngToCopy.Offset(0, -12).Resize(, 2).Cells.Count)
Set OldWorkbook = ActiveWorkbook
Set OldSheet = ActiveSheet

i = 0
For Each cell In myRngToCopy.Offset(0, -12).Resize(, 2).Cells
i = i + 1
OldSelection(i).Addr = cell.Address
OldSelection(i).Val = cell.Formula
Next cell

With myRngToCopy
.Copy
With .Offset(0, -12)
.PasteSpecial Paste:=xlPasteValues
'Selection.Style = "Calculation"
With .Resize(, 2) 'same number of rows, but two columns
.Replace What:="=", _
Replacement:="=", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
End With
End With
End With
Application.CutCopyMode = False
' Specify the Undo Sub
Application.OnUndo "Undo the CopyFormula macro", "UndoCopyFormula"
End Sub
Sub UndoCopyFormula()
' Undoes the effect of the CopyFormula sub

Dim i As Long

' Tell user if a problem occurs
On Error GoTo Problem

Application.ScreenUpdating = False

' Make sure the correct workbook and sheet are active
OldWorkbook.Activate
OldSheet.Activate

' Restore the saved information
For i = 1 To UBound(OldSelection)
Range(OldSelection(i).Addr).Formula = OldSelection(i).Val
Next i
Exit Sub

' Error handler
Problem:
MsgBox "Can't undo"
End Sub

TKS_Mark wrote:

Ok, that looks very helpful. I ran the sample program in a test file and it
worked great. Then I modified it for my purposes as below. I moved the
For-Next loop to after the offset but before the paste. I removed the Option
Explicit statement from my code because I don't know how to declare the i
variable correctly.

The trouble is, when I run the code, I still can't undo. Do you see any
errors below? How should I declare the i so I can still use Option Explicit?

'Custom data type for undoing
Type SaveRange
Val As Variant
Addr As String
End Type

' Stores info about current selection
Public OldWorkbook As Workbook
Public OldSheet As Worksheet
Public OldSelection() As SaveRange
Sub CopyFormula()

' Abort if a range isn't selected
If TypeName(Selection) < "Range" Then Exit Sub

Dim myRng As Range

'single area at a time
Set myRng = Selection.Areas(1)

With Intersect(myRng.EntireRow, ActiveSheet.Range("r1").EntireColumn)
.Copy
With .Offset(0, -12)

' The next block of statements
' saves the current values for undoing
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

.PasteSpecial Paste:=xlPasteValues
Selection.Style = "Calculation"
With .Resize(, 2) 'same number of rows, but two columns
.Replace What:="=", _
Replacement:="=", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
End With
End With
End With
Application.CutCopyMode = False
' Specify the Undo Sub
Application.OnUndo "Undo the CopyFormula macro", "UndoCopyFormula"
End Sub

Sub UndoCopyFormula()
' Undoes the effect of the CopyFormula sub

' Tell user if a problem occurs
On Error GoTo Problem

Application.ScreenUpdating = False

' Make sure the correct workbook and sheet are active
OldWorkbook.Activate
OldSheet.Activate

' Restore the saved information
For i = 1 To UBound(OldSelection)
Range(OldSelection(i).Addr).Formula = OldSelection(i).Val
Next i
Exit Sub

' Error handler
Problem:
MsgBox "Can't undo"
End Sub

"Dave Peterson" wrote:

You can read some notes from John Walkenbach he
http://j-walk.com/ss/excel/tips/tip23.htm

TKS_Mark wrote:

After I run the command below, I can't undo. What change should I make to
make it undo-able.

Thanks.

Sub CopyFormula()

Dim myRng As Range

'single area at a time
Set myRng = Selection.Areas(1)

With Intersect(myRng.EntireRow, ActiveSheet.Range("r1").EntireColumn)
.Copy
With .Offset(0, -12)
.PasteSpecial Paste:=xlPasteValues
With .Resize(, 2) 'same number of rows, but two columns
.Replace What:="=", _
Replacement:="=", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
End With
End With
End With
Application.CutCopyMode = False
End Sub

--

Dave Peterson


--

Dave Peterson


--

Dave Peterson