Q:

How to check for duplicate on specific column?

Im trying to detect duplicates on column("G") of my input workbook and by using lastrow of its data at column("E") to merge upwards by using & "" & after which it will delete the entireRow and this process continue until there are no more duplicates.

I tried and also look up for many codes including delete and duplicates but I am still having trouble.
Dim myCell As Range, myRow As Integer, myRange As Range, myCol As Integer, X As Integer

    'Count number column

Set wsInput = Workbooks("InputB.xls").Worksheets("HC_MODULAR_BOARD_20180112")

     myCol = Range(Cells(3, 7), Cells(3, 7).End(xlDown)).Count

     'Loop each column to check duplicate values & highlight them.

     For X = 3 To myRow
     Set myRange = Range(Cells(2, X), Cells(myRow, X))

     For Each myCell In myRange
     If Workbooks("InputB.xls").Worksheets("HC_MODULAR_BOARD_20180112").CountIf(myRange, myCell.Value) > 1 Then
     myCell.Interior.ColorIndex = 3

    End If
     Next
     Next

'  allow values at Column"E" to merge upwards and delete all duplicate and its row (missing)

I have no clue how to delete after copying data on top of the column. Someone please help.
Many Thanks,
Adrian

A:

You could try:
Option Explicit

Sub test()

    Dim LastRow As Long, i As Long, y As Long, Counter As Long
    Dim SearchValue As String, AddValue As String

    With ThisWorkbook.Worksheets("Sheet1") ' Always select your worksheet name

        LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        Counter = 0
        AddValue = ""
        SearchValue = ""

        For i = LastRow To 3 Step -1

            SearchValue = .Range("C" & i).Value

            If SearchValue <> "" Then

                If Application.WorksheetFunction.CountIf(.Range("C3:C" & LastRow), SearchValue) > 1 Then

                    For y = i To 3 Step -1

                        If .Range("C" & y).Value = SearchValue Then

                            If AddValue = "" Then
                                AddValue = .Range("E" & y).Value
                            Else
                                AddValue = AddValue & ", " & .Range("E" & y).Value
                                .Rows(y).EntireRow.Delete
                                Counter = Counter + 1
                            End If

                        End If

                    Next y

                    .Range("E" & i - Counter).Value = AddValue
                    AddValue = ""
                    SearchValue = ""
                    Counter = 0

                End If

            End If

        Next i

    End With

End Sub

