Find Duplicates in a column then copy data to other column in VBA-CodePudding

I am trying to figure out in VBA on how to copy and paste data when they have duplicates specifically.

what i am trying to do is.

if cells A1, A2 and A3 are duplicates I want to copy the data of H1 and paste it to H2, H3

so far i only managed find the duplicates in column A but stucked to find a solution to my problem.

Sub Doubles()
'
' Doubles Macro
' Les Doubles
'
' Touche de raccourci du clavier: Ctrl e
'
    Range("A1:I128").Select
    ActiveWindow.SmallScroll Down:=-123
    Selection.AutoFilter
    Range("A:A,H:H").Select
    Range("H1").Activate
    Selection.FormatConditions.AddUniqueValues
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).DupeUnique = xlDuplicate
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    ActiveSheet.Range("$A$1:$I$128").AutoFilter Field:=1, Criteria1:=RGB(255, _
        199, 206), Operator:=xlFilterCellColor
    ActiveSheet.AutoFilter.Sort.SortFields.Clear
    ActiveSheet.AutoFilter.Sort.SortFields.Add Key:= _
        Range("A1:A128"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveSheet.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

CodePudding user response：

Example data before running the sub:

In the rows of column-A, there are some duplicate values.

if cells A1, A2 and A3 are duplicates I want to copy the data of H1 and paste it to H2, H3

The sub assumed that in each duplicate value in column-A, there will be only one row with value in column-H. For example : In column-A, JOHN appear in cell A5, A10, A17 ---> so in column-H, the row with value will be in cell H5 or H10 or H17. In the image example above, it's only cell H5 which has value.

The expected result (from the image above):
cell H5, H10 and H17 will have value "john"
cell H6 and H18 will have value "khan"
etc

Sub test()
Dim arr As Variant: Dim el
Dim rg As Range: Dim cell As Range

With Sheets("Sheet1")
Set rg = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
End With

Set arr = CreateObject("scripting.dictionary")
For Each cell In rg: arr.Item(cell.Value) = 1: Next

For Each el In arr
    If Application.CountIf(rg, el) > 1 Then
        With rg
            .Replace el, True, xlWhole, , False, , False, False
            .SpecialCells(xlConstants, xlLogical).Offset(0, 7).Value = .SpecialCells(xlConstants, xlLogical).Offset(0, 7).SpecialCells(xlConstants).Value
            .Replace True, el, xlWhole, , False, , False, False
        End With
    End If
Next

End Sub

The macro process:

Make a range with data in column-A to variable rg
create an array from the unique value in rg as variable arr
loop to each element in arr
check how many times the element appear in rg
if the element appear more than once in rg (eg: JOHN)
it replace the element name in rg into logical TRUE (now JOHN in column-A become TRUE)
then it gets all cells in rg which has TRUE value (cell A5, A10, A17)
then offset those cells 7 to the right (cell H5, H10, H17)
then fill them with the value ---sorry it's difficult for me to explain it in English---. (fill H5, H10, H17 with H5 value).
then bring back the TRUE value in rg to the name of the element (now TRUE in column-A become JOHN again).

if cells A1, A2 and A3 are duplicates I want to copy the data of H1 and paste it to H2, H3

Once again, please remember that the code assumed that there will be only one cell which has value. From your quote above, then it only cell H1 which has value, H2 and H3 is blank/empty/no-value.

Example :
Cell A100, A200, A300, A400, A500 are duplicates.
If in H100 there is a value AND if in H500 there is a value, then the code will not run correctly. So again, there must be only one cell which has value, either it's in H100 or H200 or H300 or H400 or H500.