Write-back formulas in comment boxes into underlying cells

[Max]

Hi guys,

This is a follow-on to the great subroutines by Peter T and Dana DeLouis to
my recent post "Re: Transcribing cell formulas into their comment boxes"
at: http://tinyurl.com/7xumg which transfer a selected range's cell formulas
(if any) as text into their comment boxes. Cells w/o formulas (if any) would
have the phrase "No Formula" written into their comment boxes.

I would now like a sub to do the reverse action, i.e. write-back the
formulas from a selected range's comment boxes into the underlying cells,
overwriting cell contents, if any. And for cells with "No Formula" written
into their comment boxes (if any) -to take no action.

Any insights appreciated. Thanks.

 

[Tom Ogilvy]

Sub Cell_Add_Formula()
'// = = = = = = = = = = = = = =
'// Within a selection...
'// Adds the Cells Formula to the Cells Comoment
'// If no Formula, adds the text..."No Formula"
'// = = = = = = = = = = = = = =

'//
Dim Cell As Range
Dim sStr as String
Const Msg As String = "No Formula"
'//
If TypeName(Selection) <> "Range" Then Exit Sub

For Each Cell In Selection.Cells
With Cell
sStr = .NoteText
If sStr = "" Then
.Formula = Msg
Else
.Formula = .NoteText
End If
End With
Next Cell
End Sub


Here is a little cleaner version of the great routines.

Sub Comment_Add_Formula()
'// = = = = = = = = = = = = = =
'// Within a selection...
'// Adds the Cells Formula to the Cells Comoment
'// If no Formula, adds the text..."No Formula"
'// = = = = = = = = = = = = = =

'//
Dim Cell As Range
Const Msg As String = "No Formula"
'//
If TypeName(Selection) <> "Range" Then Exit Sub

For Each Cell In Selection.Cells
With Cell
If .HasFormula Then
.NoteText Text:=.Formula
Else
.NoteText Text:=Msg
End If
.Comment.Shape.TextFrame.AutoSize = True
.Comment.Visible = False
End With
Next Cell
End Sub

 

[Max]

Many thanks, Tom !

Runs great, but I need a small tweak in > Sub Cell_Add_Formula()
which currently writes the phrase "No Formula" into the underlying cell

The need was:

... And for cells with "No Formula" written

Here is a little cleaner version of the great routines.

....

 

[Tom Ogilvy]

Guess I didn't read closely enough:

Sub Cell_Add_Formula()
'// = = = = = = = = = = = = = =
'// Within a selection...
'// Adds the Cells Formula to the Cells Comoment
'// If no Formula, adds the text..."No Formula"
'// = = = = = = = = = = = = = =

'//
Dim Cell As Range
Dim sStr as String
Const Msg As String = "No Formula"
'//
If TypeName(Selection) <> "Range" Then Exit Sub

For Each Cell In Selection.Cells
With Cell
sStr = .NoteText
If sStr = "" or trim(sStr) = msg Then
' .ClearContents
Else
.Formula = .NoteText
End If
End With
Next Cell
End Sub

 

[Max]

Thanks, Tom !
It's got all the functionalities now ..