Remove Duplicates & Blanks in Excel VBA

Tamiz1982

New Member
Joined
Sep 11, 2020
Messages
12
Office Version
  1. 2007
Platform
  1. Windows
Hi,
I want to remove duplicate values and blank cells in excel . I have tried below code.
VBA Code:
Sub del_blanks_duplicates()
Dim i, j, lastrow As Long

    Call Activate_Cluster
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row - 1
    For i = lastrow To 1 Step -1
        For j = 1 To i
       
            If (Cells(i, 0) & Cells(i, 1) = Cells(j, 0) & Cells(j, 1)) Or (Cells(i, 0) = "") Then
                MsgBox "The Record is Duplicate / Blanks", vbCritical, Cells(i, 0) + "-A"
                Rows(i).EntireRow.Delete
                Exit For
            End If
        Next j
    Next i
           
End Sub
It shows run time errors.
Err-1.jpg
Err-2.jpg

If have any changes, please guide me.

Thank You....
 

Some videos you may like

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

Trebor76

Well-known Member
Joined
Jul 23, 2007
Messages
4,714
Hi Tamiz1982,

The second argument of the Cells function is the column reference which if a number is being used has to have a minimum number of 1 i.e. Col. A. As you have zero Excel errors out.

See how this revised code goes:

VBA Code:
Option Explicit
Sub del_blanks_duplicates()

    Dim lngMyRow As Long
    Dim lngLastRow As Long
    
    Application.ScreenUpdating = False

    Call Activate_Cluster
    
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row - 1 'Excludes the last cell??
    
    For lngMyRow = lngLastRow To 1 Step -1
        If Len(Range("A" & lngMyRow)) = 0 Or Evaluate("COUNTIF(A:A,A" & lngMyRow & ")") > 1 Then
            MsgBox "The record in row " & lngMyRow & " is either a duplicate or is blank", vbCritical
            Rows(lngMyRow).Delete
            Exit For 'This will stop the process after the first deletion??
        End If
    Next lngMyRow
    
    Application.ScreenUpdating = True
           
End Sub

I've put some questions where I wasn't sure what the logic was.

Regards,

Robert
 

Tamiz1982

New Member
Joined
Sep 11, 2020
Messages
12
Office Version
  1. 2007
Platform
  1. Windows
Thank you for reply....
I want to compare two cells (Registration No & Applicant Name) are same its duplicate & should be deleted also if first column blank cell
m_Duplicate-Unique.jpg

i have called function which is active sheet.
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row - 1 'Excludes the last cell??
VBA Code:
Public Sub Activate_Cluster()

    Dim ws As Worksheet
   
   
    If Cluster1.Value = True Then
     
        ThisWorkbook.Sheets("Cluster-1").Activate
        Set ws = ActiveSheet
        ws.Activate
    ElseIf Cluster2.Value = True Then
       
         ThisWorkbook.Sheets("Cluster-2").Activate
         Set ws = ActiveSheet
        ws.Activate
    Else
       
        ThisWorkbook.Sheets("Cluster-3").Activate
        Set ws = ActiveSheet
        ws.Activate
       
    End If
   
End Sub
 
Last edited:

Trebor76

Well-known Member
Joined
Jul 23, 2007
Messages
4,714
Try this (though initially on a copy of your data as the results cannot be undone if they are not as expected):

VBA Code:
Option Explicit
Sub Macro1()

    Dim lngMyRow As Long
    Dim lngLastRow As Long
    Dim cln As New Collection
    Dim strMyKey As String
    
    Application.ScreenUpdating = False
    
    lngLastRow = Range("D:E").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    For lngMyRow = lngLastRow To 1 Step -1
        strMyKey = Trim(Range("D" & lngMyRow)) & Trim(Range("E" & lngMyRow))
        If Len(strMyKey) = 0 Then
            Rows(lngMyRow).Delete
        Else
            On Error Resume Next
                cln.Add strMyKey, CStr(strMyKey)
                If Err.Number <> 0 Then
                    Rows(lngMyRow).Delete
                End If
            On Error GoTo 0
        End If
    Next lngMyRow
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert
 

Tamiz1982

New Member
Joined
Sep 11, 2020
Messages
12
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

Thanks for reply. But it is delete if Registration No entered.

If Registration No same but Applicant Name is different it should be accepted . How to do....?
 

Trebor76

Well-known Member
Joined
Jul 23, 2007
Messages
4,714
Not sure what you mean :confused:

The code joins D and E and will delete any row if:

1. The length of the join is zero (i.e. columns D and E had no entries)
2. The join has a duplicate (the first is kept)
 

Tamiz1982

New Member
Joined
Sep 11, 2020
Messages
12
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

Its working but it does not delete entire row only also remaining rows deleted which i have applied formulas.
my input column is A & B others are applied formulas based on inputs.
Sorry for incontinence.....
Before :
Formula_Avail-Before-min.jpg
After
No Formula_Avail-After-min.jpg
 

Trebor76

Well-known Member
Joined
Jul 23, 2007
Messages
4,714
You've lost me I'm afraid :(

Hopefully someone else in the forum will be able to help :)
 

Tamiz1982

New Member
Joined
Sep 11, 2020
Messages
12
Office Version
  1. 2007
Platform
  1. Windows
Thank you for your Patience. :)
Manually i checked with help of separate new workbook. Its working. Usually looking into your coding, its worked.
But in my workbook I have another sheet which is linked it. I found & correct it.
Sorry for taken your lots of time, please.
Again Thanks a lot....🥰
 

Watch MrExcel Video

Forum statistics

Threads
1,122,949
Messages
5,599,025
Members
414,274
Latest member
LisaGreen

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top