Solved Remove duplicates row on basis of certain condition (1 Viewer)

suryu

Member
Local time
Today, 17:26
Joined
Apr 3, 2020
Messages
86
I want to remove duplicates loan number from column B only if column name D "Bank Name" is blank or column name " City" is blank using vba
 

Micron

AWF VIP
Local time
Today, 07:56
Joined
Oct 20, 2018
Messages
3,476
If it's an occasional thing, just filter by the columns and delete the rows? Not sure how many Excel vba "power" users there are on this forum. I always search here under "new posts" and seldom see any Excel vba questions or answers here.
 

Darrell

Registered User.
Local time
Today, 11:56
Joined
Feb 1, 2001
Messages
299
A bit tricky without seeing any sample data, however something like this may work for you, though please note that with your criteria I have assumed that if there are duplicates then there is at least one record which ALWAYS has the Bank Name and the City populated.

I have also assumed that there could be a large volume of deletions so have done this so it performs only one deletion step as doing many of them one at a time can be very slow.

Code:
Sub Remove_Duplicates()

Dim wsLoan_Sheet As Worksheet
Dim sLoanNum As String
Dim iLoopCtr As Integer
Dim x As Integer
Dim iDelRow As Integer

Set wsLoan_Sheet = ThisWorkbook.Sheets(1)    '<-- Change to reference your data sheet

' Sort by Loan Number (Col B), Bank Name (Col D), City (Col E)
With wsLoan_Sheet
    .Range("B1:E" & .UsedRange.Rows.Count).Sort Key1:=.Range("B1"), Order1:=xlAscending, Key2:=.Range("D1"), Order2:=xlAscending, _
        Key3:=.Range("E1"), Order3:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    
    ' Validate deletion rules
    For iLoopCtr = 2 To .UsedRange.Rows.Count
        sLoanNum = .Range("B" & iLoopCtr)
        x = 1
        
        ' Is it the only instance of this Loan Number
        If .Range("B" & iLoopCtr + x) = sLoanNum Then
            
            ' Validate first instance of Loan Number
            If IsEmpty(.Range("D" & iLoopCtr)) Or IsEmpty(.Range("E" & iLoopCtr)) Then
                .Range("F" & iLoopCtr) = "Delete"
            End If
                
            ' Validate other instances of Loan Number
            Do Until Not .Range("B" & iLoopCtr + x) = sLoanNum
                If IsEmpty(.Range("D" & iLoopCtr + x)) Or IsEmpty(.Range("E" & iLoopCtr + x)) Then
                    .Range("F" & iLoopCtr + x) = "Delete"
                End If
                x = x + 1
            Loop
        End If
        iLoopCtr = iLoopCtr + x - 1
    Next iLoopCtr
    
    ' Sort to perform mass deletion
    .Range("B1:F" & .UsedRange.Rows.Count).Sort Key1:=.Range("F1"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    
    iDelRow = .Range("F" & .UsedRange.Rows.Count).End(xlUp).Row
    
    .Rows("2:" & iDelRow).Delete shift:=xlUp
    .Columns("F:F").Delete shift:=xlLeft
    
     ' Sort by Loan Number
    .Range("B1:E" & .UsedRange.Rows.Count).Sort Key1:=.Range("B1"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

End With

Set wsLoan_Sheet = Nothing
End Sub
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 19:56
Joined
May 7, 2009
Messages
19,169
i think the need to Remove the Loan Number. not to delete the whole Row.
it could be that the Cell has multiple Loan Number on it.
 

Darrell

Registered User.
Local time
Today, 11:56
Joined
Feb 1, 2001
Messages
299
i think the need to Remove the Loan Number. not to delete the whole Row.

Hmm now I read that again I think you're right. Oh well, shouldn't be too difficult to tweak...
 

Isaac

Lifelong Learner
Local time
Today, 04:56
Joined
Mar 14, 2017
Messages
8,738
I want to remove duplicates loan number from column B only if column name D "Bank Name" is blank or column name " City" is blank using vba
Are you talking about removing some of the text out of a single cell in column B, or are you talking about deleting an entire row if it meets the logic?
If you are talking about removing just some "text" from the cell, can you mention if there is any way the Loan Numbers are delimited within cell, or provide sample file.
Please see attached.
 

Attachments

  • Testing 20200715.jpg
    Testing 20200715.jpg
    51.1 KB · Views: 98

suryu

Member
Local time
Today, 17:26
Joined
Apr 3, 2020
Messages
86
i think the need to Remove the Loan Number. not to delete the whole Row.
it could be that the Cell has multiple Loan Number on it.
Hi, need to delete whole row
please find below screenshot

SRLoan_numberIDbank_namecity
1​
1110002​
234​
DB bank
2​
1110002​
445​
- need to delete as nothing is there in bank_name & city
3​
1234000​
66​
NY
4​
1234000​
344​
-need to delete
 
Last edited:

suryu

Member
Local time
Today, 17:26
Joined
Apr 3, 2020
Messages
86
A bit tricky without seeing any sample data, however something like this may work for you, though please note that with your criteria I have assumed that if there are duplicates then there is at least one record which ALWAYS has the Bank Name and the City populated.

I have also assumed that there could be a large volume of deletions so have done this so it performs only one deletion step as doing many of them one at a time can be very slow.

Code:
Sub Remove_Duplicates()

Dim wsLoan_Sheet As Worksheet
Dim sLoanNum As String
Dim iLoopCtr As Integer
Dim x As Integer
Dim iDelRow As Integer

Set wsLoan_Sheet = ThisWorkbook.Sheets(1)    '<-- Change to reference your data sheet

' Sort by Loan Number (Col B), Bank Name (Col D), City (Col E)
With wsLoan_Sheet
    .Range("B1:E" & .UsedRange.Rows.Count).Sort Key1:=.Range("B1"), Order1:=xlAscending, Key2:=.Range("D1"), Order2:=xlAscending, _
        Key3:=.Range("E1"), Order3:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
  
    ' Validate deletion rules
    For iLoopCtr = 2 To .UsedRange.Rows.Count
        sLoanNum = .Range("B" & iLoopCtr)
        x = 1
      
        ' Is it the only instance of this Loan Number
        If .Range("B" & iLoopCtr + x) = sLoanNum Then
          
            ' Validate first instance of Loan Number
            If IsEmpty(.Range("D" & iLoopCtr)) Or IsEmpty(.Range("E" & iLoopCtr)) Then
                .Range("F" & iLoopCtr) = "Delete"
            End If
              
            ' Validate other instances of Loan Number
            Do Until Not .Range("B" & iLoopCtr + x) = sLoanNum
                If IsEmpty(.Range("D" & iLoopCtr + x)) Or IsEmpty(.Range("E" & iLoopCtr + x)) Then
                    .Range("F" & iLoopCtr + x) = "Delete"
                End If
                x = x + 1
            Loop
        End If
        iLoopCtr = iLoopCtr + x - 1
    Next iLoopCtr
  
    ' Sort to perform mass deletion
    .Range("B1:F" & .UsedRange.Rows.Count).Sort Key1:=.Range("F1"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
  
    iDelRow = .Range("F" & .UsedRange.Rows.Count).End(xlUp).Row
  
    .Rows("2:" & iDelRow).Delete shift:=xlUp
    .Columns("F:F").Delete shift:=xlLeft
  
     ' Sort by Loan Number
    .Range("B1:E" & .UsedRange.Rows.Count).Sort Key1:=.Range("B1"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

End With

Set wsLoan_Sheet = Nothing
End Sub
Hi approach is correct but it is deleting all rows
please find screenshot below for output result i want


SRLoan_numberIDbank_namecity
11110002234DB bank
21110002445-need to delete as city and bank_name is empty
3123400066NY
41234000344-need to delete
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 19:56
Joined
May 7, 2009
Messages
19,169
Code:
Public Sub DeleteBlankRows()
    Dim SourceRange As Range
    Dim EntireRow As Range
    Dim Len_1 As Integer
    Dim Len_2 As Integer
    Dim i As Long
    
    'replace Sheet1 with the correct sheet to work with
    Set SourceRange = Sheet1.UsedRange
 
    If Not (SourceRange Is Nothing) Then
        Application.ScreenUpdating = False
 
        For i = SourceRange.Rows.Count To 2 Step -1
            Set EntireRow = SourceRange.Cells(i, 1).EntireRow
            Len_1 = Len(SourceRange.Cells(i, 4) & "")
            Len_2 = Len(SourceRange.Cells(i, 5) & "")
            If (Len_1 + Len_2) = 0 Then
                EntireRow.Delete
            End If
        Next
 
        Application.ScreenUpdating = True
    End If
End Sub
 

suryu

Member
Local time
Today, 17:26
Joined
Apr 3, 2020
Messages
86
Code:
Public Sub DeleteBlankRows()
    Dim SourceRange As Range
    Dim EntireRow As Range
    Dim Len_1 As Integer
    Dim Len_2 As Integer
    Dim i As Long
   
    'replace Sheet1 with the correct sheet to work with
    Set SourceRange = Sheet1.UsedRange

    If Not (SourceRange Is Nothing) Then
        Application.ScreenUpdating = False

        For i = SourceRange.Rows.Count To 2 Step -1
            Set EntireRow = SourceRange.Cells(i, 1).EntireRow
            Len_1 = Len(SourceRange.Cells(i, 4) & "")
            Len_2 = Len(SourceRange.Cells(i, 5) & "")
            If (Len_1 + Len_2) = 0 Then
                EntireRow.Delete
            End If
        Next

        Application.ScreenUpdating = True
    End If
End Sub
This code is working fine .
Thank you :)
 

Users who are viewing this thread

Top Bottom