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
i think the need to Remove the Loan Number. not to delete the whole Row.
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?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
Hi, need to delete whole rowi 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.
SR | Loan_number | ID | bank_name | city |
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 |
Hi approach is correct but it is deleting all rowsA 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
SR | Loan_number | ID | bank_name | city |
1 | 1110002 | 234 | DB bank | |
2 | 1110002 | 445 | -need to delete as city and bank_name is empty | |
3 | 1234000 | 66 | NY | |
4 | 1234000 | 344 | -need to delete |
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 .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