If Duplicate, copy info into other Duplicates

[KGards7]

Hi all,

I need to assign a macro to a button which basically does the following:

If there is a duplicate in column A then whatever data is in columns S, T and U for the first entry is to copy to all duplicates.

E.g. if there are 5 cells in column A that each read "Test1" then whatever is in column S, T and U for the very first "Test1" needs to copy to all other "Test1"'s in the sheet.

Hope this makes sense. Thank you and again your help is and always will be greatly appreciated.

 

[GSP75]

Sure, here's a VBA macro that should do what you need:
Sub CopyDataForDuplicates()
Dim lastRow As Long
Dim dict As Object
Dim i As Long
Dim key As Variant
Dim firstRow As Long
Dim sVal As String
Dim tVal As String
Dim uVal As String

'Get the last row of data in column A
lastRow = Range("A" & Rows.Count).End(xlUp).Row

'Create a dictionary object to store the first row number for each unique value in column A
Set dict = CreateObject("Scripting.Dictionary")
For i = 2 To lastRow
If Not dict.Exists(Range("A" & i).Value) Then
dict.Add Range("A" & i).Value, i
End If
Next i

'Loop through the dictionary and copy data as needed
For Each key In dict.Keys
firstRow = dict(key)
sVal = Range("S" & firstRow).Value
tVal = Range("T" & firstRow).Value
uVal = Range("U" & firstRow).Value
For i = firstRow + 1 To lastRow
If Range("A" & i).Value = key Then
Range("S" & i).Value = sVal
Range("T" & i).Value = tVal
Range("U" & i).Value = uVal
End If
Next i
Next key
End Sub

You can assign this macro to a button on your worksheet by right-clicking on the button, selecting "Assign Macro," and then choosing the name of this macro from the list.

 

[KGards7]

Sure, here's a VBA macro that should do what you need:
Sub CopyDataForDuplicates()
Dim lastRow As Long
Dim dict As Object
Dim i As Long
Dim key As Variant
Dim firstRow As Long
Dim sVal As String
Dim tVal As String
Dim uVal As String

'Get the last row of data in column A
lastRow = Range("A" & Rows.Count).End(xlUp).Row

'Create a dictionary object to store the first row number for each unique value in column A
Set dict = CreateObject("Scripting.Dictionary")
For i = 2 To lastRow
If Not dict.Exists(Range("A" & i).Value) Then
dict.Add Range("A" & i).Value, i
End If
Next i

'Loop through the dictionary and copy data as needed
For Each key In dict.Keys
firstRow = dict(key)
sVal = Range("S" & firstRow).Value
tVal = Range("T" & firstRow).Value
uVal = Range("U" & firstRow).Value
For i = firstRow + 1 To lastRow
If Range("A" & i).Value = key Then
Range("S" & i).Value = sVal
Range("T" & i).Value = tVal
Range("U" & i).Value = uVal
End If
Next i
Next key
End Sub

You can assign this macro to a button on your worksheet by right-clicking on the button, selecting "Assign Macro," and then choosing the name of this macro from the list.

Works Perfectly!!

Thank you!!!