Problema con check box en excel

Tengo un problema con las casillas de verificación y es lo siguiente: para idéntico texto al clickear un me activa la condición de verdadero en las dos (resultado) en otra hoja, paso la macro y las pantallas.

Saludos

S
'
'
Sub RefreshList()
Dim rA, rO As Single
Dim Rng As Range
Dim CLeft, CTop, CHeight, CWidth As Double
Application.ScreenUpdating = False
Set Rng = Selection
'Cambiar hasta F para limpiar las celdas .DAM
Range("D7:F" & Rows.Count) = ""
rA = Worksheets("Acción").Range("B" & Rows.Count).End(xlUp).Row
ActiveSheet.CheckBoxes.Delete
If Range("B3").Value <> "" And rA > 1 Then
Do
If Worksheets("Acción").Range("B" & rA) = Range("B3").Value Then
rO = Worksheets("ppal").Range("D" & Rows.Count).End(xlUp).Row + 1
Worksheets("ppal").Range("D" & rO) = Worksheets("Acción").Range("C" & rA).Value
'se agrega la fecha en F .DAM
Worksheets("ppal").Range("F" & rO) = Worksheets("Acción").Range("E" & rA).Value
CLeft = Cells(rO, "E").Left
CTop = Cells(rO, "E").Top
CHeight = Cells(rO, "E").Height
CWidth = Cells(rO, "E").Width
ActiveSheet.CheckBoxes.Add(CLeft + CWidth / 2 - 8, CTop, CWidth, CHeight).Select
With Selection
.Caption = ""
If Worksheets("Acción").Range("D" & rA).Value = 1 Then
.Value = 1
Else
.Value = xlOff
End If
.Display3DShading = False
End With
End If
rA = rA - 1
Loop Until rA = 1
End If
Rng.Select
Application.ScreenUpdating = True
End Sub
'
Sub AddCheckboxes()
Dim Rng As Range
Dim cell, LRow As Single
Dim chkbx As CheckBox
Dim CLeft, CTop, CHeight, CWidth As Double
Application.ScreenUpdating = False
Set Rng = Selection
ActiveSheet.CheckBoxes.Delete
LRow = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row
For cell = 8 To LRow
If Cells(cell, "D").Value <> "" Then
CLeft = Cells(cell, "E").Left
CTop = Cells(cell, "E").Top
CHeight = Cells(cell, "E").Height
CWidth = Cells(cell, "E").Width
ActiveSheet.CheckBoxes.Add(CLeft + CWidth / 2 - 8, CTop, CWidth, CHeight).Select
With Selection
.Caption = ""
.Value = xlOff
.Display3DShading = False
End With
End If
Next cell
Rng.Select
Application.ScreenUpdating = True

End Sub
'