Copy notes in other cells

[Rock5150]

Hello

I have a spreadsheet where I would like to add comments in column E. However if other similar rows have the same article number in column A, I would like excel to automatically copy the same comment into other cells as well without retyping and scrolling back and forth remembering what comment I put.

I am on a work Mac and cannot load the xl2b2 file on my work laptop. sorry. But in short, is there a formula so that say in the very first row in the fifth column I put "No links to be added", that that comment if it sees the same article number elsewhere "24556112" anywhere, that it will auto populate "No links to be added" in other cells simultaneously. (See second table where the first row item is the same).

 

[Skyybot]

Try this on a copy of your Workbook.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Target.Column = Me.Range("E:E").Column Then Application.EnableEvents = True: Exit Sub
Dim ref As Range, srng As Range, fnd As Range, nfnd As Range, i As Integer, lr As Long, rngs As New Collection
Set ref = Target.Offset(0, -4)
lr = Columns(1).Rows(Rows.Count).End(xlUp).Row
Set srng = Range(Cells(1, 1), Cells(lr, 1))
Set fnd = srng.Find(What:=ref.Value, LookAt:=xlWhole)
If Not fnd Is Nothing Then
    rngs.Add fnd.Address
    Set nfnd = srng.FindNext(fnd)
    If Not nfnd Is Nothing Then
        Do Until nfnd.Address = fnd.Address
            rngs.Add nfnd.Address
            Set nfnd = srng.FindNext(nfnd)
        Loop
        For i = 1 To rngs.Count
            Range(rngs.Item(i)).Offset(0, 4).Value = Target.Value
        Next i
    End If
End If
Application.EnableEvents = True
End Sub

 

[Rock5150]

Try this on a copy of your Workbook.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Target.Column = Me.Range("E:E").Column Then Application.EnableEvents = True: Exit Sub
Dim ref As Range, srng As Range, fnd As Range, nfnd As Range, i As Integer, lr As Long, rngs As New Collection
Set ref = Target.Offset(0, -4)
lr = Columns(1).Rows(Rows.Count).End(xlUp).Row
Set srng = Range(Cells(1, 1), Cells(lr, 1))
Set fnd = srng.Find(What:=ref.Value, LookAt:=xlWhole)
If Not fnd Is Nothing Then
    rngs.Add fnd.Address
    Set nfnd = srng.FindNext(fnd)
    If Not nfnd Is Nothing Then
        Do Until nfnd.Address = fnd.Address
            rngs.Add nfnd.Address
            Set nfnd = srng.FindNext(nfnd)
        Loop
        For i = 1 To rngs.Count
            Range(rngs.Item(i)).Offset(0, 4).Value = Target.Value
        Next i
    End If
End If
Application.EnableEvents = True
End Sub

Does this only work in Windows?

 

[Skyybot]

Dunno. I don't Apple. If it doesn't work for MAC I'm sure someone on here can convert it.