2 way cell linking - multiple cells and multiple sheets

purple5621

New Member
Joined
Jun 11, 2021
Messages
3
Office Version
  1. 2019
Platform
  1. Windows
Hi All!

I am very new to VBA and working on a project that is way out of my league. I would really appreciate some help

I am trying to write a code that will allow 2-way entry between cells on many different sheets. I have been able to find some code that links multiple cells on one sheet to multiple cells on another sheet. But I am trying to link some cells from sheet1 to cells on sheet2 and then link different cells on sheet1 to cells on sheet3. I am hoping to link different cells on sheet1 to many different sheets in the workbook.


Here is what I am hoping to be able to do:

Sheet1 B4:P4 linked to Sheet2 C26:C41

Sheet1 B5:P5 linked to Sheet3 C:26:C41

Sheet1 B6:P6 linked to Sheet4 C26:C41

Sheet1 B7:P7 linked to Sheet5 C26:C41

.

.

Sheet1 B37:P37 linked to Sheet38 C26:C41

Thanks!
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,864
Office Version
  1. 2010
Platform
  1. Windows
Here is the code to do the first link (sheet1 B4 to P4 to Sheet 2 C26:C41 . you can do the other link by just copying the code and altering the ranges and the offsets
put this code in the sheet1 code:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim tcell As Range
If Not (Intersect(Target, Range("B4:P4")) Is Nothing) Then
 For Each tcell In Target
    colno = tcell.Column
    With Worksheets("Sheet2")
    Application.EnableEvents = False
     .Range(.Cells(24 + colno, 3), .Cells(24 + colno, 3)) = tcell.Value
    Application.EnableEvents = True
    End With
 Next tcell
End If
End Sub
then put this code in sheet 2 code:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim tcell As Range
If Not (Intersect(Target, Range("C26:C41")) Is Nothing) Then
 For Each tcell In Target
    rowno = tcell.Row
    With Worksheets("Sheet1")
    Application.EnableEvents = False
     .Range(.Cells(4, rowno - 24), .Cells(4, rowno - 24)) = tcell.Value
    Application.EnableEvents = True
    End With
 Next tcell
End If
End Sub
 

shknbk2

Active Member
Joined
Mar 5, 2016
Messages
373
Office Version
  1. 365
Platform
  1. Windows
offtheclip's answer is great, but it got me thinking about generalizing the same sort of function so that you wouldn't have to update the code in every sheet.

My solution is kind of similar except I use a new linking sheet (called "Links") to identify the data that should be linked. Each row identifies the link back and forth between the sheets. Columns A and D are the sheet names and B-C are the start and end ranges on "Sheet2" that should be linked with the start and end ranges E-F of the sheets in column D.

(By the way, your B4:P4 range is 15 cells, while C26-C41 is 16 cells. I'm not sure which range is longer or shorter than needed. In my Links sheet, I went from B4 to Q4 so there would be 16 cells in each linked range.)

In a new module, I have the following code, which gets called by all of the linked sheets:
VBA Code:
Sub LinkCells(ByVal T As Range, Sh As Worksheet)
    Dim searchCol As Integer
    Dim isectRange As Range
    Dim linkRange As Range
    Dim ofset As Integer
    Dim i As Integer
    
    With Sheets("Links")
        If Sh.Name = .Range("A1").Value Then
            searchCol = 1
            ofset = 3
        Else
            searchCol = 4
            ofset = -3
        End If
        For i = 1 To .Range("A1").CurrentRegion.Rows.Count
            Set isectRange = Sheets(.Cells(i, searchCol).Value).Range(.Cells(i, searchCol + 1).Value & ":" & .Cells(i, searchCol + 2).Value)
            If Not (Intersect(T, isectRange) Is Nothing) Then
                Set linkRange = Sheets(.Cells(i, searchCol).Offset(0, ofset).Value).Range(.Cells(i, searchCol + 1).Offset(0, ofset).Value & ":" & .Cells(i, searchCol + 2).Offset(0, ofset).Value)
                Application.EnableEvents = False
                linkRange.Value = WorksheetFunction.Transpose(isectRange.Value)
                Application.EnableEvents = True
                Exit For
            End If
        Next
    End With
End Sub
The reason for this is that you can now only need the following code in each linked sheet, and it doesn't need to change.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    LinkCells Target, Me
End Sub
This worksheet code can get copied to each sheet's code. Plus, if you then copy the sheet later on, the code is already there and doesn't need to change.

The LinkCells code above checks to see if any of the cells in one of the linked ranges in any of the linked sheets is changed. If it is, it copies all linked cells to the other sheet. For example, if Sheet3.C27 is changed, C26:C41 is copied to Sheet2.B4:Q4. So any change to any linked cell copies all linked cells (the Transpose part) to make the code easier.

A version of my "Links" sheet is below to show an example.
Book1
ABCDEF
1Sheet2B4Q4Sheet3C26C41
2Sheet2B5Q5Sheet4C26C41
3Sheet2B6Q6Sheet5C26C41
4Sheet2B7Q7Sheet6C26C41
5Sheet2B8Q8Sheet7C26C41
6Sheet2B9Q9Sheet8C26C41
7Sheet2B10Q10Sheet9C26C41
Links
 

purple5621

New Member
Joined
Jun 11, 2021
Messages
3
Office Version
  1. 2019
Platform
  1. Windows
Thank you both so much, this is amazing!


@shknbk2 I do have one follow-up question about your solution. I really like the idea of the 'links' sheets since it is way easier than modifying the code for each sheet. It was working great for me until I changed the names of some of the sheets in the workbook. I changed Sheet2 to "Salary Overview" and Sheet3 to "Main." I updated the sheet names on the Links tab, but I still got a range error when I entered a value into a cell on the Salary overview tab. Is there a way that I can use this code but also be able to change the tab names?
 

shknbk2

Active Member
Joined
Mar 5, 2016
Messages
373
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

I changed the sheet names, and it works fine. If you debug the error, can you tell what the issue is?
Linked cells.xlsm
ABCDEF
1Salary OverviewB4Q4MainC26C41
2Salary OverviewB5Q5Sheet4C26C41
3Salary OverviewB6Q6Sheet5C26C41
4Salary OverviewB7Q7Sheet6C26C41
5Salary OverviewB8Q8Sheet7C26C41
6Salary OverviewB9Q9Sheet8C26C41
7Salary OverviewB10Q10Sheet9C26C41
Links

Linked cells.xlsm
BCDEFGHIJKLMNOPQ
412345678910111213141516
Salary Overview

Linked cells.xlsm
C
261
272
283
294
305
316
327
338
349
3510
3611
3712
3813
3914
4015
4116
Main
 

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
24,024
Another generalization approach.
If you want Sheet1!$A$1 linked with Sheet2!$B$2
Put Data validation on Sheet1!$A$1 with the formula =TRUE and the Error Title of Cell Link and the Error Message of Sheet2!$B$2
Then put this code in the ThisWorkbook code module
VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim OtherCell As Range
    With Target
        If .Cells.Count = 1 Then
            If .Validation.ErrorTitle = "Cell Link" Then
                Set OtherCell = Range(.Validation.ErrorMessage)
            End If
        End If
    End With
    If Not OtherCell Is Nothing Then
    
        With OtherCell
            With .Validation
                .Delete
                .Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertInformation, Operator:=xlBetween, Formula1:="=true"
                .ErrorTitle = "Cell Link"
                .ErrorMessage = Target.Address(, , , True)
            End With
            Application.EnableEvents = False
            .Value = Target.Value
            Application.EnableEvents = True
        End With
       
    End If
    
End Sub
Then copy that validation to any other cell you want paired and change the Error Message in each cell's validation to the address of the cell it is linked with.
 

purple5621

New Member
Joined
Jun 11, 2021
Messages
3
Office Version
  1. 2019
Platform
  1. Windows
I changed the sheet names, and it works fine. If you debug the error, can you tell what the issue is?
Linked cells.xlsm
ABCDEF
1Salary OverviewB4Q4MainC26C41
2Salary OverviewB5Q5Sheet4C26C41
3Salary OverviewB6Q6Sheet5C26C41
4Salary OverviewB7Q7Sheet6C26C41
5Salary OverviewB8Q8Sheet7C26C41
6Salary OverviewB9Q9Sheet8C26C41
7Salary OverviewB10Q10Sheet9C26C41
Links

Linked cells.xlsm
BCDEFGHIJKLMNOPQ
412345678910111213141516
Salary Overview

Linked cells.xlsm
C
261
272
283
294
305
316
327
338
349
3510
3611
3712
3813
3914
4015
4116
Main

I just tried again and it worked this time. I don't know what I did wrong last time. Thanks!


One more question - it is possible that I will need to link some of the cells on Sheet1 to cells other than C26:C41. Can I do this? For example, I might need to link Sheet1 B5:P5 to Sheet2 Y33:Y48. I tried entering these values into the links sheets and seeing what happened. When I update values on Sheet1 B5:P5, they are reflected on Sheet2 Y33:Y48. However, if I try to update the values on Sheet2, I get the following message "Run-time error '1004' Method 'Intersect of Object'_Global' failed"


Is it possible for me to be able to link the values in Sheet1 to whatever cells I want on the other sheets by just entering the values into columns E&F on the ‘Links’ tab?
 

shknbk2

Active Member
Joined
Mar 5, 2016
Messages
373
Office Version
  1. 365
Platform
  1. Windows
Is it possible for me to be able to link the values in Sheet1 to whatever cells I want on the other sheets by just entering the values into columns E&F on the ‘Links’ tab?
Yes, that was the intention of this method. I think once the new code is used below, it should work this way.

After researching a bit on the error you got, I found that you can't use Intersect with different sheets, which is what happens in the code. Best to first check to make sure they are on the same sheet. This code adds an If statement first to make sure the isectRange and T are on the same sheet If isectRange.Parent Is T.Parent Then. Replace your code with this.
VBA Code:
Sub LinkCells(ByVal T As Range, Sh As Worksheet)
    Dim searchCol As Integer
    Dim isectRange As Range
    Dim linkRange As Range
    Dim ofset As Integer
    Dim i As Integer
    
    With Sheets("Links")
        If Sh.Name = .Range("A1").Value Then
            searchCol = 1
            ofset = 3
        Else
            searchCol = 4
            ofset = -3
        End If
        For i = 1 To .Range("A1").CurrentRegion.Rows.Count
            Set isectRange = Sheets(.Cells(i, searchCol).Value).Range(.Cells(i, searchCol + 1).Value & ":" & .Cells(i, searchCol + 2).Value)
            If isectRange.Parent Is T.Parent Then
                If Not (Intersect(T, isectRange) Is Nothing) Then
                    Set linkRange = Sheets(.Cells(i, searchCol).Offset(0, ofset).Value).Range(.Cells(i, searchCol + 1).Offset(0, ofset).Value & ":" & .Cells(i, searchCol + 2).Offset(0, ofset).Value)
                    Application.EnableEvents = False
                    linkRange.Value = WorksheetFunction.Transpose(isectRange.Value)
                    Application.EnableEvents = True
                    Exit For
                End If
            End If
        Next
    End With
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,133,527
Messages
5,659,335
Members
418,497
Latest member
VAllen79

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top