Macro to copy formula while keeping original cell references

[excel_monkey]

Hi,

I'm trying to create a VBA macro that will allow me to copy a formula from one sheet to another whilst keeping all the original references.

E.g.

If the formula on Sheet1 is:

= sum(A1:B6)

then the copied formula on Sheet2 would read

=sum(Sheet1!A1:Sheet1!B6)

You can do this by cuting the cell, but I don't want to do this, I want to leave the original cell unchanged.

I'm sure there is some simple VBA code to do this, but I can't seem to figure it out.

Thanks in advance.

 

[excel_monkey]

Hi guys,

Thanks for the posts.

Norie, just putting a formula that references the first formula isn't really what I'm after. I need the actual formula itself to be copied.

Mikerickson, your examples are fine, but they depend on the original formula have been written with full references. If they haven't been written in that way it doesn't work. For example when copied from sheet1 to sheet2 I get the following:

SUM(Sheet1!A1:B1) --> SUM(Sheet1!A1:B1)

SUM(A1:B1) --> SUM(A1:B1)

What I want is something that will do this:

SUM(A1:B1) --> SUM(Sheet1!A1:B1)

When copied from Sheet1 to Sheet2.

Does that make sense? Thanks for your help.

 

[Norie]

What are you actually trying to achieve?

 

[mikerickson]

What I want is something that will do this:

SUM(A1:B1) --> SUM(Sheet1!A1:B1)

Excel doesn't work that way. The presence of the sheet speicifcation is the sheet-wise equivilant of $ in absolute/relative adresssing.

If you want a formula to keep its sheet reference after being copy/pasted, qualify it. It's much easier (and more stable and robust) to use the built-in functionality of Excel than to write special code.

I agree with Norie, knowing what your goal is will help determine if a custom copy/paste routine is needed, or if Named ranges would be a better approach or......

 

[excel_monkey]

Two different things:

1. a shortcut to copy a formula from one sheet to another whilst keeping the original references. This is handy when building models etc.

2. I want to use a trace precedents routine to give me a list of all the precedents for a cell and I want my macro to run without deleting the undo history.

I have figured out that if I copy the formula for which I want to trace precedents to another workbook using formula_string = activecell.formula I can run the trace precedents proceedure without vba deleting the undo history in my original workbook.

For the macro to return the correct references it needs to have a formula that is referenced properly. This is my problem.

I'm using an adapted version of the code posted here:

http://www.ozgrid.com/forum/showthread.php?t=17028

My version of this code is below. This works, but does not pick up the correct references as the formula hasn't be converted how I would like it to be.

Using a cut or copy method to copy the formula to the new book isn't any good as vba then deletes the undo history in the original workbook.

Hopefully this all makes sense, sorry for the long winded explanation!

Sub Excel_monkey_FindPrecedents()
 
'***added by excel_monkey***
formula_string = ActiveCell.Formula
Set temp_book = Application.Workbooks.Add
temp_book.Worksheets(1).Range("A1").Formula = formula_string
temp_book.Worksheets(1).Range("A1").Select
'***************************
 
    Dim rLast As Range, iLinkNum As Integer, iArrowNum As Integer
    Dim stMsg As String
    Dim bNewArrow As Boolean
    Application.ScreenUpdating = False
    ActiveCell.ShowPrecedents
    Set rLast = ActiveCell
    iArrowNum = 1
    iLinkNum = 1
    bNewArrow = True
    Do
        Do
            Application.Goto rLast
            On Error Resume Next
            ActiveCell.NavigateArrow TowardPrecedent:=True, ArrowNumber:=iArrowNum, LinkNumber:=iLinkNum
            If err.Number > 0 Then Exit Do
            On Error GoTo 0
            If rLast.Address(external:=True) = ActiveCell.Address(external:=True) Then Exit Do
            bNewArrow = False
            If rLast.Worksheet.Parent.Name = ActiveCell.Worksheet.Parent.Name Then
                If rLast.Worksheet.Name = ActiveCell.Parent.Name Then
                    ' local
                    stMsg = stMsg & vbNewLine & Selection.Address
                Else
                    stMsg = stMsg & vbNewLine & "'" & Selection.Parent.Name & "'!" & Selection.Address
                End If
            Else
                ' external
                stMsg = stMsg & vbNewLine & Selection.Address(external:=True)
            End If
            iLinkNum = iLinkNum + 1  ' try another  link
         Loop
        If bNewArrow Then Exit Do
        iLinkNum = 1
        bNewArrow = True
        iArrowNum = iArrowNum + 1  'try another arrow
    Loop
    rLast.Parent.ClearArrows
    Application.Goto rLast
'***addedd by excel_monkey***
    temp_book.Close SaveChanges:=False
'****************************
    MsgBox "Precedents are" & stMsg
    Exit Sub
End Sub