Excel macro to find duplicates and copy their adjacent cells

0
votes

I need a macro that loops column C and locates the duplicate values and copies them to col D, once a duplicate value is located it would copy the adjacent value from Col A and place it in Col E

example desired output:

A                 B                C              D            E
Project1          test1            quiz1         quiz1        Project1
Project2          test2            quiz1         quiz1        Project2
Project3          test3            quiz2
4
excelvbamacos
To get a truely meaningful answer please read the FAQ with instructions stackoverflow.com/questions/how-to-ask and a personal favorite of mine: mattgemmell.com/2008/12/08/what-have-you-tried – K_B

4 Answers

0
votes
  1. sort on column C
  2. loop through the rows and check if selectedrow.cells(1,3)=selectedrow.cells(2,3)
  3. if they are equal copy value of column C to column D, for both this row and next row. also copy column A to column E for this row and next row.
  4. loop until the c column of the selectedrow is empty.
0
votes

I have this sub for this case ..

Sub CheckDupl()
Dim x, i, nD As Integer
Dim c As String
Dim nLimit As Integer
Dim bFound As Boolean

nLimit = 3 '--> you can change this
nD = 1

For x = 1 To 3
  Cells(x, 6) = "x"
  c = Cells(x, 3)
  bFound = False
  For n = x + 1 To nLimit
    If Not Cells(n, 6) = "x" Then
      If Cells(n, 3) = c Then
        If Not bFound Then
          bFound = True
          Cells(nD, 4) = Cells(x, 3)
          Cells(nD, 5) = Cells(x, 1)
          MsgBox n
          Cells(nD + 1, 4) = Cells(n, 3)
          Cells(nD + 1, 5) = Cells(n, 1)
          Cells(n, 6) = "x"
          nD = nD + 2
        Else
          Cells(nD, 4) = Cells(n, 3)
          Cells(nD, 5) = Cells(n, 1)
          Cells(n, 6) = "x"
          nD = nD + 1
        End If

      End If
    End If
  Next
Next
End Sub

You can activate by button .. and Column F is used for help, you can delete it !

0
votes

It can be done this way:

Sub dp()

AR = Cells(Rows.Count, "A").End(xlUp).Row

For Each p1 In Range(Cells(1, 3), Cells(AR, 3))
    For Each p2 In Range(Cells(1, 3), Cells(AR, 3))
        If p1 = p2 And Not p1.Row = p2.Row Then
            Cells(p1.Row, 4) = Cells(p1.Row, 3)
            Cells(p2.Row, 4) = Cells(p2.Row, 3)
            Cells(p1.Row, 5) = Cells(p1.Row, 1)
            Cells(p2.Row, 5) = Cells(p2.Row, 1)
        End If
    Next p2
Next p1

End Sub
0
votes

Why use a macro at all? Why not just this formula in column D?

=IF(COUNTIF(C:C,C1)>1, C1,"")

And to finish the task, this formula in column E:

=IF(D1="", "", A1)

Easier than VBA, would process faster, as well, I would think.