I have a macro that I want to write, and I believe I have it structured
approximately correctly, but I have no clue about the proper syntax for
several of the commands/structures, and my system administrator did not
include VBA Help with our standard installation.
The basic idea this--take an existing worksheet that's full of stuff,
and for a given specified formula, replace all cells containing that
formula with the formula's value, and leave the rest alone. Output as a
new sheet.
So here's what I've sketched out. It's a hodgepodge of all the different
languages that I don't know very well. Can someone help me fix the
syntax? Thanks!!
Sub DupAndSelectivePasteValues()
'
' DupAndSelectivePasteValues Macro
' Copies the original sheet into a new output sheet
' Replaces all instances of a specified function with values and
' alerts user of new sheet name and count of modified cells
i = 1
Count = 0
MaxSheets = whatever Excel's max is
PurgeFunction = whatever function I want to purge
Original = current sheet name
'create the output sheet
If Count of Workbook Sheets > MaxSheets Then
alert ("Too many damn sheets!")
halt
End If
While True
NewSheet = "Output" & i
if not exist NewSheet then exit ' if okay to create NewSheet then
exit loop
i = i + 1 ' otherwise increment sheetname until does not exist
Loop
Sheets(Original).Copy After:=NewSheet 'create the output sheet
NewSheet.Activate
'fix the desired cells
TopLeft = a1
BottomRight = SpecialCells(xlCellTypeLastCell)
TopLeft: BottomRight.Select 'select all relevant cells
with Each cell In Selection 'go thru each cell
Activate
If ISERR(FIND(PurgeFunction,(cell("contents",ActiveCell))))
Then 'skip if cell does not contain the f(x)
Next
Else 'otherwise PasteSpecialValues
ActiveCell.Copy
ActiveCell.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Count = Count + 1 'keep a running count of how
many cells modified
Next
End If
End With
AlertString = "Results output as " & NewSheet & ", " & Count & "
cells modified."
alert (AlertString)
End Sub
--
A rich man who hailed from Seattle #```````
Wrote Win95 to do battle, # ```````
But Mac users pity # ```````
The masses not witty # ```````
Enough to know Wintel's for cattle. #. ```````
~ ~ . \_@_/ ```````
^_@ o . V ```````
Steven "Rocket Man" Kan `-' - \_@_ ~ . ######
mailto:ste...@kan.org V \ ~ . ######
http://www.kan.org ~ . #H2O##
Everybody S.H.I.N.E. ~ .#POLO#
Support Heterogeneity In Networked Environments ~ ~ ######
I penned this 'starter code' just before I left for work and hoped it may
give you a start. It works only on the activesheet and as designed, only
finds an exact match for the entered formula, NOT a relative equivalent. To
do this, you will need to develop it a little further. (ConvertFormula,
Absolute, RelativeTo, etc.). It only copies the activesheet to the end of
the current worksheets. It does no checking for XL limits, although from
memory, it's limited only by system memory, so is hard to check, without
simply checking for the error thrown up by reaching this maximum.
Try the code and post back for any additional help you need.
Sub purgeFormula()
Dim purgeFormula As String
Dim x As Long
Dim rRange As Range
Dim myCell As Range
Set rRange = ActiveSheet.UsedRange
x = 0
purgeFormula = Application.ConvertFormula(Application.InputBox("Enter the
formula to purge", "Formula", , , , , , 0), xlR1C1, xlA1)
For Each myCell In rRange.SpecialCells(xlCellTypeFormulas)
If myCell.Formula = purgeFormula Then
myCell.Copy
myCell.PasteSpecial Paste:=xlPasteValues
x = x + 1
End If
Next myCell
MsgBox x & " occurrence(s) of the formula: " & purgeFormula & " have been
converted to values"
ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
End Sub
--
HTH
Nick Hodge
Southampton, England
nick_...@lineone.net
Steven Kan <ste...@kan.org> wrote in message
news:38B9F86E...@kan.org...
Sub purgeFormula()
'Nick Hodge 2000-02-28 excel.worksheet.functions
'convert specified formula to value, modified version
Dim purgeFormula As String
Dim x As Long
Dim rRange As Range
Dim myCell As Range
Set rRange = ActiveSheet.UsedRange
x = 0
'-------
purgeFormula = Application.InputBox("Enter the " & _
"formula to purge", "Formula", ActiveCell.Formula, , , , , 0)
If purgeFormula = "" Then Exit Sub
If Left(purgeFormula, 1) <> "=" Then Exit Sub
purgeFormula = Application.ConvertFormula(purgeFormula, xlR1C1, xlA1)
'-------
For Each myCell In rRange.SpecialCells(xlCellTypeFormulas)
If myCell.Formula = purgeFormula Then
myCell.Copy
myCell.PasteSpecial Paste:=xlPasteValues
x = x + 1
End If
Next myCell
MsgBox x & " occurrence(s) of the formula: " & purgeFormula & _
I'm glad someone picked it up and ran with it, I was in a hurry this morning
and it kinda appealed to me this one. It's now 00:17 and I've just got
back, with only time to pick up threads I started, so thanks for the assist.
--
HTH
Nick Hodge
Southampton, England
nick_...@lineone.net
David McRitchie <DMcRi...@msn.com> wrote in message
news:#kspO0hg$GA.254@cpmsnbbsa05...
Nick and David, thanks for the input. Again, I'm not terribly VBA-savvy,
so forgive me if this is a no-brainer:
How would I modify the macro to purge all formulae containing this
function, regardless of the operands (or surrounding functions, for that
matter)? In my original "strawman" version I attempted to use Excel's
FIND() function with the formula strings.
For example, I want to purge all instances of a custom function called
"HKEY()" regardless of whether it's HKEY(something), HKEY(something
else) or STDEVP(HKEY(a),HKEY(b),HKEY(c)), etc. In all of these cases I
want to replace the cell's entire contents with the value.
Thanks!
purgeFormula, will convert to values all formulas on the sheet
having an exact match to the supplied formula. (spaces count)
i.e. =A1 + 1 is not the same as =A1+1
purgeFormulaSTR, will convert to values all formulas on the sheet
containing the supplied string.
i.e. HKEY( as in your request
purgeFormula is corrected from the previously posted formula
which was making changes to the original before making
the copy. If you don't want the copy remove that line.
'----------------------------------------------------
Sub purgeFormula()
'Nick Hodge 2000-02-28 excel.worksheet.functions
'convert specified formula to value, modified version 2
Dim purgeFormula As String
Dim purgeFormula2 As String
Dim x As Long
Dim rRange As Range
Dim myCell As Range
x = 0
'-------
purgeFormula = Application.InputBox("Formulas Exactly matching " _
& "the following formula will be converted to values", _
"purgeFormula", ActiveCell.Formula, , , , , 0)
If purgeFormula = "" Then Exit Sub
If Left(purgeFormula, 1) <> "=" Then Exit Sub
purgeFormula = Application.ConvertFormula(ActiveCell.Formula, xlR1C1, xlA1)
ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
'-------
Set rRange = ActiveSheet.UsedRange
For Each myCell In rRange.SpecialCells(xlCellTypeFormulas)
If purgeFormula = Application.ConvertFormula(myCell.Formula, xlR1C1, xlA1)
Then
myCell.Copy
myCell.PasteSpecial Paste:=xlPasteValues
x = x + 1
End If
Next myCell
MsgBox x & " occurrence(s) of the formula: " & purgeFormula & _
" have been converted to values"
End Sub
Sub purgeFormulaSTR()
'Nick Hodge 2000-02-28 excel.worksheet.functions
'convert formulas to value based on specified String
'specified string could be the entire formula or part of it
Dim purgeFormula As String
Dim x As Long
Dim rRange As Range
Dim myCell As Range
x = 0
purgeFormula = Application.InputBox("Formulas will be " _
& "converted to value, when the formula contains the " _
& "following string of characters", _
"purgeFormulaSTR", ActiveCell.Formula)
If purgeFormula = "" Then Exit Sub
ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
Set rRange = ActiveSheet.UsedRange
For Each myCell In rRange.SpecialCells(xlCellTypeFormulas)
If InStr(1, UCase(myCell.Formula), UCase(purgeFormula), 1) Then
myCell.Copy
myCell.PasteSpecial Paste:=xlPasteValues
x = x + 1
End If
Next myCell
MsgBox x & " occurrence(s) of the formula: " & purgeFormula & _
" have been converted to values"
End Sub
'----------------------------------------------------
The tread began: http://www.deja.com/=dnc/getdoc.xp?AN=590705514
Nick Hodge nick_...@lineone.net supplied the original solution
HTH,
David McRitchie, Microsoft MVP - Excel
My Excel Pages: http://members.aol.com/dmcritchie/excel/excel.htm
Steven Kan <ste...@kan.org> wrote