Macro to delete duplicate cell without sorting

[Chito]

Looking for a macro to satisfy the below my requirement.

Example Data:

ColumnA	ColumnB	ColumnC
Jane	500	Female
Jane	200	Female
Mike	500	Male
Mike	200	Male

Expected Data:

ColumnA	ColumnB	ColumnC
Jane	500	Female
	200
Mike	500	Male
	200

[vikas.bhandari]

Hi there!

Assuming you are running it on Data sorted by ColumnA, the code would be :

Public Sub DeleteDuplicates()
    Dim lastRow As Long
    Dim rowCounter As Long
    
    lastRow = ActiveSheet.Range("A65000").End(xlUp).Row
    
    For rowCounter = 2 To lastRow
        If ActiveSheet.Range("A" & rowCounter).value <> "" Then
            ClearDuplicateCells ActiveSheet.Range("A" & rowCounter)
        End If
    Next rowCounter
    
End Sub

Public Sub ClearDuplicateCells(currentCell As Range)
    Dim rng As Range
    Dim sht As Worksheet
    Dim value
    Dim lastRow As Long
    Dim c As Range
    Dim runLoop As Boolean
    Dim unionRng As Range
     
    value = currentCell.value
    Set unionRng = currentCell
    Set sht = currentCell.Parent
    Set rng = sht.Range(currentCell.Offset(0, 0), sht.Cells(currentCell.Row + 100000, currentCell.Column))
     
    lastRow = 0
    runLoop = True
     
    With rng
        Set c = .Find(value, LookIn:=xlValues)
         
        If Not c Is Nothing Then
             
            
            While runLoop
                If Not c Is Nothing Then
                    If c.Row > lastRow Then
                        c.ClearContents
                        lastRow = c.Row
                        Set c = .FindNext(c)
                    Else
                        runLoop = False
                    End If
                Else
                    runLoop = False
                End If
            Wend
        Else
            '''MsgBox "Didnt find the value"
        End If
    End With
     
    Dim newRange As Range
    
     
     
End Sub

However, if the data is not sorted, it won't really make much sense to remove duplicates.

Thanks,
Vikas B

[Chito]

Thanks Vikas for quick reply, hoever I am getting "Run-time error '1004'". When i debug it is higlighting the below code. I am still new to macro, your help would be appreciated.

Set rng = sht.Range(currentCell.Offset(0, 0), sht.Cells(currentCell.Row + 100000, currentCell.Column))

[vikas.bhandari]

Hi,

Your workbook may be in compatibility mode which may not have 100000 rows. So use this :

Set rng = sht.Range(currentCell.Offset(0, 0), sht.Cells(currentCell.Row + 60000, currentCell.Column))

[Chito]

Thanks, that was easy one . Now I am able to get the result what I wanted in ColumnA but my data range is A:BQ, do I have to modify for each column and run the macro or is there anything which can run at one shot?

Regards,
Chito