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

[unpronounciable]

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.

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!

 

[ZVI]

May be this:

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

 

[unpronounciable]

Thank you very much, it WORKED!

 

[unpronounciable]

The code is now

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.

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.