Variation on dynamic Linked Cells code

[bkg73123]

Hello,

I found the code below in an article from this website and it does exactly what I need, but it also does more than what I need.
Can some one please modify this code to only link the cells values?
I do not need it to link the cells formats, comments, etc.
In fact this messes up the look I am going for on the two separate sheets.
Thank you!

Sincerely,
Brandon

[bkg73123]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Map As Variant, x As Variant
Dim i As Long, j As Long, k As Long, n As Long, nRows As Long
Dim cel As Range, rg As Range
Dim ws1 As Worksheet, ws2 As Worksheet

With Worksheets("Mapping") 'Map contains the mapping relationships
Set ws1 = Worksheets(.Range("A1").Value) 'Take name of first worksheet from Mapping!A1
Set ws2 = Worksheets(.Range("B1").Value) 'Take name of first worksheet from Mapping!B1
If Sh.Name <> ws1.Name And Sh.Name <> ws2.Name Then Exit Sub 'Neither linked worksheet was changed--exit sub
Map = Range(.Cells(2, 1), .Cells(65536, 2).End(xlUp))
End With
nRows = UBound(Map) 'Number of mapping relationships in table

Application.ScreenUpdating = False 'Turn off screenupdating so code runs faster and no flicker
Application.EnableEvents = False 'Turn off events so this sub isn't called recursively
On Error GoTo errhandler 'If a fatal error occurs, turn screen updating and events handling back on

For i = 1 To nRows 'Remove workbook and worksheet name from the mapping table
For j = 1 To 2
x = InStr(1, Map(i, j), ":")
If x = 0 Then
Map(i, j) = Range(Map(i, j)).Address
Else
Map(i, j) = Range(Left(Map(i, j), x - 1)).Address & ":" & Range(Mid(Map(i, j), x + 1)).Address
End If
Next j
Next i

For Each cel In Target
Select Case Sh.Name
Case ws1.Name
For i = 1 To nRows
If Map(i, 1) <> "" Then
Set rg = ws1.Range(Map(i, 1))
If Not Intersect(rg, cel) Is Nothing Then 'Is cel contained in a mapped range?
j = cel.Row - rg.Row 'Number of rows cel is below start of mapped range
k = cel.Column - rg.Column 'Number of columns cel is to right of mapped range
'cel.Copy 'The PasteSpecial method preserves the relative relationship of formulas
'ws2.Range(Map(i, 2)).Cells(1, 1).Offset(j, k).PasteSpecial xlPasteFormulas
cel.Copy ws2.Range(Map(i, 2)).Cells(1, 1).Offset(j, k) 'Paste formats, values & formulas
Application.CutCopyMode = True 'Clear the clipboard
End If
End If
Next i
Case ws2.Name
For i = 1 To nRows
If Map(i, 2) <> "" Then
Set rg = ws2.Range(Map(i, 2))
If Not Intersect(rg, cel) Is Nothing Then
j = cel.Row - rg.Row
k = cel.Column - rg.Column
'cel.Copy
'ws1.Range(Map(i, 1)).Cells(1, 1).Offset(j, k).PasteSpecial xlPasteFormulas
cel.Copy ws1.Range(Map(i, 1)).Cells(1, 1).Offset(j, k)
Application.CutCopyMode = True
End If
End If
Next i
End Select
Next cel
errhandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub






How to use:



Add a worksheet to your workbook called Mapping. This worksheet will specify the links between two different worksheets.
Put the name of the two worksheets in Mapping!A1 and B1
Put the cell or range addresses to be linked in columns A and B. A static link is an address like B5 or C4:D6. A dynamic link uses a formula like: =CELL("address",Summary!A12) or =CELL("address",Summary!D11) & ":" & CELL("address",Summary!D13)
Copy above code.
In Excel press Alt + F11 to enter the VBE.
Press Ctrl + R to show the Project Explorer.
Double click the ThisWorkbook on the left pane.
Paste code into the right pane.
Press Alt + Q to close the VBE.
Save workbook before any other changes.




Test the code:



Open the sample workbook.
Notice the mapping relationships shown on the Mapping worksheet. Some links are static, while others are dynamic.
On either the Summary or Detail worksheet, change a value in one of the cells highlighted in pale yellow. The change will automatically be reflected in the linked cell on the other worksheet.
On the Summary worksheet, change the formula in cell D5. Note that similar changes appear in the formula in Detail!D6, only with adjustments for the difference in row number.
Changes to the value or formula of a linked cell are always reflected in the other cell. Changes to the format are reflected only if Excel thinks the cell value changed; you can fake this by changing the format, then clicking in the formula bar and hitting Enter.
Select one of the dynamically linked cells, such as Summary!B12 and drag it to another location. Then change its value. Note that the linked cell on the other worksheet changes accordingly.
Select one of the static linked cells, such as Summary!A1 and drag it to another location. Then change its value. Note that the linked cell on the other worksheet does not change at all.

[bkg73123]

The original poster byundt answered the question.
Here is the modified code requested.
Byundt just turned off the lines of code that weren't desired.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Map As Variant, x As Variant
Dim i As Long, j As Long, k As Long, n As Long, nRows As Long
Dim cel As Range, rg As Range
Dim ws1 As Worksheet, ws2 As Worksheet

With Worksheets("Mapping") 'Map contains the mapping relationships
Set ws1 = Worksheets(.Range("A1").Value) 'Take name of first worksheet from Mapping!A1
Set ws2 = Worksheets(.Range("B1").Value) 'Take name of first worksheet from Mapping!B1
If Sh.Name <> ws1.Name And Sh.Name <> ws2.Name Then Exit Sub 'Neither linked worksheet was changed--exit sub
Map = Range(.Cells(2, 1), .Cells(65536, 2).End(xlUp))
End With
nRows = UBound(Map) 'Number of mapping relationships in table

Application.ScreenUpdating = False 'Turn off screenupdating so code runs faster and no flicker
Application.EnableEvents = False 'Turn off events so this sub isn't called recursively
On Error GoTo errhandler 'If a fatal error occurs, turn screen updating and events handling back on

For i = 1 To nRows 'Remove workbook and worksheet name from the mapping table
For j = 1 To 2
x = InStr(1, Map(i, j), ":")
If x = 0 Then
Map(i, j) = Range(Map(i, j)).Address
Else
Map(i, j) = Range(Left(Map(i, j), x - 1)).Address & ":" & Range(Mid(Map(i, j), x + 1)).Address
End If
Next j
Next i

For Each cel In Target
Select Case Sh.Name
Case ws1.Name
For i = 1 To nRows
If Map(i, 1) <> "" Then
Set rg = ws1.Range(Map(i, 1))
If Not Intersect(rg, cel) Is Nothing Then 'Is cel contained in a mapped range?
j = cel.Row - rg.Row 'Number of rows cel is below start of mapped range
k = cel.Column - rg.Column 'Number of columns cel is to right of mapped range
cel.Copy 'The PasteSpecial method preserves the relative relationship of formulas
ws2.Range(Map(i, 2)).Cells(1, 1).Offset(j, k).PasteSpecial xlPasteFormulas
'cel.Copy ws2.Range(Map(i, 2)).Cells(1, 1).Offset(j, k) 'Paste formats, values & formulas
Application.CutCopyMode = True 'Clear the clipboard
End If
End If
Next i
Case ws2.Name
For i = 1 To nRows
If Map(i, 2) <> "" Then
Set rg = ws2.Range(Map(i, 2))
If Not Intersect(rg, cel) Is Nothing Then
j = cel.Row - rg.Row
k = cel.Column - rg.Column
cel.Copy
ws1.Range(Map(i, 1)).Cells(1, 1).Offset(j, k).PasteSpecial xlPasteFormulas
'cel.Copy ws1.Range(Map(i, 1)).Cells(1, 1).Offset(j, k)
Application.CutCopyMode = True
End If
End If
Next i
End Select
Next cel
errhandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub