When a value in a cell changes, other cells (which rows are specified in the target row) will change too

unpronounciable

New Member
Joined
Feb 27, 2011
Messages
6
When a value in a cell changes, other cells (which rows are specified in the target row) will change too.

I admit, the question is confusing, so I give the example.


A​

B​

1​

3​

2​

3​

1​

4​

<TBODY>
</TBODY>


Values in cells B1 and B3 are manually entered. Basically what I want is whatever values that I entered in A1 will be duplicated in row 3 (as specified in B1). Vice versa, whatever value that I entered in A3 will be duplicated in row 1 (as specified in B3).

Using this macro, I'm able to get the result.

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
            Cancel = True 'Prevent going into Edit Mode
                If Target = vbNullString Then
                    Target = ChrW(&H2713)
                    If Target.Offset(0, 1).Value <> vbNullString Then Cells(Target.Offset(0, 2).Value, 10) = ChrW(&H2713)
                Else
                    Target.ClearContents
                    If Target.Offset(0, 1).Value <> vbNullString Then Cells(Target.Offset(0, 2).Value, 10) = vbNullString
                End If
    End If
End Sub

So if I ticked A1, cell A3 will be ticked as well.

A​

B​

1​

✓​

3​

2​

3​

✓​

1​

4​

<TBODY>
</TBODY>


However, I need loops for multiple duplications, and I have no idea how.


A​

B​

1​

3|5|6​

2​

3​

1|5|6​

4​

5​

6​

1|3|5​

<TBODY>
</TBODY>

I want if I tick A1, cells A3, A5 and A6 (rows 3, 5 and 6 as specified in B1) will be ticked as well.

And thank you in advance for your interest and valuable input!
 

Some videos you may like

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,800
Office Version
  1. 2016
  2. 2010
  3. 2007
Platform
  1. Windows
May be this:
Rich (BB code):
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim a, b
  If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
  b = Target.Offset(0, 1).Value
  If Len(b) = 0 Then Exit Sub
  Cancel = True
  ' Clear A-column (comment it if it's not required)
  On Error Resume Next: Intersect(Columns(1), Me.UsedRange).ClearContents
  ' Put flags into A-column according to value of adjacent B-cell
  a = Target.Address & ",A" & Join(Split(b, "|"), ",A")
  Range(a) = ChrW(&H2713)
End Sub
 
Last edited:

unpronounciable

New Member
Joined
Feb 27, 2011
Messages
6
The code is now

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim a, b
    Cancel = True
    If Intersect(Target, Range("J:J")) Is Nothing Then Exit Sub
    b = Target.Offset(0, 2).Value
    If Target = vbNullString Then
        Target = ChrW(&H2713)
        If Len(b) = 0 Then Exit Sub
        ' Clear A-column (comment it if it's not required)
        ' On Error Resume Next: Intersect(Columns(1), Me.UsedRange).ClearContents
        ' Put flags into A-column according to value of adjacent B-cell
        a = Target.Address & ",J" & Join(Split(b, "|"), ",J")
        Range(a) = ChrW(&H2713)
    Else
        Target.ClearContents
        If Len(b) = 0 Then Exit Sub
        a = Target.Address & ",J" & Join(Split(b, "|"), ",J")
        Range(a) = vbNullString
    End If
End Sub

The Else part is basically if someone erased the tick in one particular row, all other data with the referenced rows will also be erased.

But now I found a few problems.

1. It only worked when double-clicked. I tried adding Private Sub Worksheet_Change, but I got looping calculation, and had to force quit.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c, d
    Cancel = True
    If Intersect(Target, Range("J:J")) Is Nothing Then Exit Sub
    d = Target.Offset(0, 2).Value
    If Target = ChrW(&H2713) Then
        If Len(d) = 0 Then Exit Sub
        ' Clear A-column (comment it if it's not required)
        ' On Error Resume Next: Intersect(Columns(1), Me.UsedRange).ClearContents
        ' Put flags into A-column according to value of adjacent B-cell
        c = Target.Address & ",J" & Join(Split(d, "|"), ",J")
        Range(c) = vbNullString
    Else
        Target.ClearContents
        If Len(d) = 0 Then Exit Sub
        c = Target.Address & ",J" & Join(Split(d, "|"), ",J")
        Range(c) = ChrW(&H2713)
    End If
End Sub

2. It doesn't work on hidden/filtered rows.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,187
Messages
5,594,753
Members
413,930
Latest member
Nela817

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