Paste Link with Format?

[RonMcNatt]

I have an excel sheet where users will enter numbers on one worksheet and the values are linked to another. Establishing the link from one cell to another is not a problem, I did a copy, paste special, paste link.

My question is can you mimic the format of the original cell. So if it is formated as a percentage, the linked cell shows the number as a percentage. If they change the format to number with 3 decimals, the linked cell now shows a number with three decimals.

The format of the original cell will be changing, so I can't just manually format both cells.

Thanks in advance for the help.

Ron McNatt

 

[Zathras]

There may be an easier way (I've been caught before), but here is one way to do it with macros. Note that the actual updating of the format does not take place until the user clicks away from the cell that was reformatted. Paste the code below into the Sheet code (not a module). Specifically, the sheet from which you did the copy.

Option Explicit

Private SaveAddress As String
Private SaveFormat As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Test for whether the user has changed the number format
' in the previously selected cell.
' If a number format has changed, then update formats in
' all cells that are linked to the changed cell.
' Remember the current cell address and number format for the next
' selection change.

Dim LinkedBook As Workbook
Dim CurrentFormat As String
  
If SaveAddress <> &quot;&quot; Then
  CurrentFormat = Range(SaveAddress).NumberFormat
  If CurrentFormat <> SaveFormat Then
    UpdateLinkFormats ActiveWorkbook.Name, _
      ActiveSheet.Name, SaveAddress, CurrentFormat
  End If
End If
SaveAddress = Target.Address
SaveFormat = Target.NumberFormat
End Sub

Private Sub UpdateLinkFormats(FromBook As String, _
     FromSheet As String, FromAddress As String, NewFormat As String)
' Search all sheets in all open books to find all those that
' are linked from the given address.
' Update the number format of all those found.

Dim SearchFor As String
Dim b As Workbook
Dim w As Worksheet
Dim r As Range
 
Application.ScreenUpdating = False
For Each b In Application.Workbooks
  If b.Name <> FromBook Then
    For Each w In b.Worksheets
      For Each r In w.UsedRange
        If r.HasFormula Then
          If InStr(r.Formula, SearchFor) > 0 Then
            r.NumberFormat = NewFormat
          End If
        End If
      Next r
    Next w
  End If
Next b
Application.ScreenUpdating = True
End Sub

 

[Zathras]

There is a bug that bites if selecting a row.
Please apply this patch:

Replace the lines

SaveAddress = Target.Address
SaveFormat = Target.NumberFormat

with the following:

If Target.Count = 1 Then
  SaveAddress = Target.Address
  SaveFormat = Target.NumberFormat
End If

Sorry for the inconvenience.