Comparing 2 columns and deleting duplicates in one row

[jacinthn]

i found some coding for comparing 2 columns and clearing the contents, of the duplicate value in one of the columns but i am getting an error in VBA on the below line

If Range(Cells(J, 1), Cells(J, 2)).Value = Range(Cells(I, 1), Cells(I, 2)).Value Then

i have 2 columns that have the same name values H and K i need to delete the duplicate names out of column k and delete the values out of 2 cells next to the name that gets deleted , i cant seem to find any coding to do this.


Dim sheet As Worksheet
Dim I, J As Long

Set sheet = Sheets("Sheet1")

For I = 1 To sheet.UsedRange.Rows.Count
sheet.Range(Cells(I, 1), Cells(I, 2)).Select
For J = 1 To sheet.UsedRange.Rows.Count
If Range(Cells(J, 1), Cells(J, 2)).Value = Range(Cells(I, 1), Cells(I, 2)).Value Then
Rows(J).Select
Selection.Delete Shift:=xlUp
End If
Next J
Next I
End Sub

<TABLE style="WIDTH: 396pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=528 border=0><COLGROUP><COL style="WIDTH: 102pt; mso-width-source: userset; mso-width-alt: 4973" width=136><COL style="WIDTH: 48pt" span=2 width=64><COL style="WIDTH: 102pt; mso-width-source: userset; mso-width-alt: 4973" width=136><COL style="WIDTH: 48pt" span=2 width=64><TBODY><TR style="HEIGHT: 18.75pt; mso-height-source: userset" height=25><TD class=xl63 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; WIDTH: 102pt; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 18.75pt; BACKGROUND-COLOR: silver" width=136 height=25>MANAGER</TD><TD class=xl63 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 48pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: silver" width=64>TOTAL</TD><TD class=xl63 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 48pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: silver" width=64>STATUS</TD><TD class=xl63 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 102pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: silver" width=136>ASSISTANT MANAGER</TD><TD class=xl63 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 48pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: silver" width=64>TOTAL</TD><TD class=xl63 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext; WIDTH: 48pt; BORDER-BOTTOM: windowtext 0.5pt solid; BACKGROUND-COLOR: silver" width=64>STATUS</TD></TR><TR style="HEIGHT: 18.75pt; mso-height-source: userset" height=25><TD class=xl64 style="BORDER-RIGHT: #d0d7e5 0.5pt solid; BORDER-TOP: #d0d7e5 0.5pt solid; BORDER-LEFT: #d0d7e5 0.5pt solid; WIDTH: 102pt; BORDER-BOTTOM: #d0d7e5 0.5pt solid; HEIGHT: 18.75pt; BACKGROUND-COLOR: transparent" width=136 height=25></TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD><TD class=xl64 style="BORDER-RIGHT: #d0d7e5 0.5pt solid; BORDER-TOP: #d0d7e5 0.5pt solid; BORDER-LEFT: #d0d7e5 0.5pt solid; WIDTH: 102pt; BORDER-BOTTOM: #d0d7e5 0.5pt solid; BACKGROUND-COLOR: transparent" width=136></TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD></TR><TR style="HEIGHT: 18.75pt; mso-height-source: userset" height=25><TD class=xl64 style="BORDER-RIGHT: #d0d7e5 0.5pt solid; BORDER-TOP: #d0d7e5; BORDER-LEFT: #d0d7e5 0.5pt solid; WIDTH: 102pt; BORDER-BOTTOM: #d0d7e5 0.5pt solid; HEIGHT: 18.75pt; BACKGROUND-COLOR: transparent" width=136 height=25>RICHARDS,LISA</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>524</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>1</TD><TD class=xl64 style="BORDER-RIGHT: #d0d7e5 0.5pt solid; BORDER-TOP: #d0d7e5; BORDER-LEFT: #d0d7e5 0.5pt solid; WIDTH: 102pt; BORDER-BOTTOM: #d0d7e5 0.5pt solid; BACKGROUND-COLOR: transparent" width=136>RICHARDS,LISA</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>524</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>2</TD></TR><TR style="HEIGHT: 18.75pt; mso-height-source: userset" height=25><TD class=xl64 style="BORDER-RIGHT: #d0d7e5 0.5pt solid; BORDER-TOP: #d0d7e5; BORDER-LEFT: #d0d7e5 0.5pt solid; WIDTH: 102pt; BORDER-BOTTOM: #d0d7e5 0.5pt solid; HEIGHT: 18.75pt; BACKGROUND-COLOR: transparent" width=136 height=25>SUPLE,BRIAN</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>421</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>2</TD><TD class=xl64 style="BORDER-RIGHT: #d0d7e5 0.5pt solid; BORDER-TOP: #d0d7e5; BORDER-LEFT: #d0d7e5 0.5pt solid; WIDTH: 102pt; BORDER-BOTTOM: #d0d7e5 0.5pt solid; BACKGROUND-COLOR: transparent" width=136>GREEN,GLEN</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD></TR><TR style="HEIGHT: 18.75pt; mso-height-source: userset" height=25><TD class=xl64 style="BORDER-RIGHT: #d0d7e5 0.5pt solid; BORDER-TOP: #d0d7e5; BORDER-LEFT: #d0d7e5 0.5pt solid; WIDTH: 102pt; BORDER-BOTTOM: #d0d7e5 0.5pt solid; HEIGHT: 18.75pt; BACKGROUND-COLOR: transparent" width=136 height=25></TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD><TD class=xl64 style="BORDER-RIGHT: #d0d7e5 0.5pt solid; BORDER-TOP: #d0d7e5; BORDER-LEFT: #d0d7e5 0.5pt solid; WIDTH: 102pt; BORDER-BOTTOM: #d0d7e5 0.5pt solid; BACKGROUND-COLOR: transparent" width=136>BAXTER, LARRY</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>10</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>26</TD></TR><TR style="HEIGHT: 18.75pt; mso-height-source: userset" height=25><TD class=xl64 style="BORDER-RIGHT: #d0d7e5 0.5pt solid; BORDER-TOP: #d0d7e5; BORDER-LEFT: #d0d7e5 0.5pt solid; WIDTH: 102pt; BORDER-BOTTOM: #d0d7e5 0.5pt solid; HEIGHT: 18.75pt; BACKGROUND-COLOR: transparent" width=136 height=25></TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD><TD class=xl64 style="BORDER-RIGHT: #d0d7e5 0.5pt solid; BORDER-TOP: #d0d7e5; BORDER-LEFT: #d0d7e5 0.5pt solid; WIDTH: 102pt; BORDER-BOTTOM: #d0d7e5 0.5pt solid; BACKGROUND-COLOR: transparent" width=136>SUPLE, BRIAN</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>421</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>3</TD></TR></TBODY></TABLE>

I Need to delete the managers out of the assistent manager column if they appear ( which they dont always do)
please help

 

[btadams]

This seems to work given the example you posted:

Sub DeleteMgrs()
Dim i As Long, j As Long, LastRow As Long

    ' First delete any empty rows
    Call DeleteEmptyRows
    
    ' Count items in columns A
    k = Application.CountA(Range("A2", Cells(Rows.Count, 1).End(xlUp)))
    
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        
        For j = 1 To k
        LastRow = ActiveSheet.UsedRange.Rows.Count
            For i = LastRow To 1 Step -1
'                MsgBox Cells(i, 4).Value
'                MsgBox Cells(j + 1, 1).Value
                If UCase(Trim(Cells(i, 4).Value)) = UCase(Trim(Cells(j + 1, 1).Value)) Then Range(Cells(i, 4), Cells(i, 6)).Delete shift:=xlUp
            Next i
        Next j
    
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Sub DeleteEmptyRows()
'Deletes the entire row within the selection if the ENTIRE row
'contains no data.
Dim LastRow As Long, LastColumn As Long, r As Long

        With Application
            .Calculation = xlCalculationManual
            .ScreenUpdating = False
    
            LastRow = ActiveSheet.UsedRange.Rows.Count
            For r = LastRow To 1 Step -1
                If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
            Next r
        
            .Calculation = xlCalculationAutomatic
            .ScreenUpdating = True
        End With
End Sub

 

[jacinthn]

just tested it, it doesnt seem to be working when it says column A in the code should i change that to H? because the manager list is in column H and the one with the assistant managers is in column K and if it matches i need to delete the duplicate value from column k and also the values next to the duplicate in column L and M. so from column k to column m i need to delete that part of the row

 

[jacinthn]

thanks for your response by the way

 

[btadams]

Yes, change the line

k = Application.CountA(Range("A2", Cells(Rows.Count, 1).End(xlUp)))

to

k = Application.CountA(Range("H2", Cells(Rows.Count, 8).End(xlUp)))


and change the line

If UCase(Trim(Cells(i, 4).Value)) = UCase(Trim(Cells(j + 1, 1).Value)) Then Range(Cells(i, 4), Cells(i, 6)).Delete shift:=xlUp

to

If UCase(Trim(Cells(i, 4).Value)) = UCase(Trim(Cells(j + 1, 8).Value)) Then Range(Cells(i, 4), Cells(i, 6)).Delete shift:=xlUp

 

[jacinthn]

just got home and updated the code. no idea what im doing wrong but nothing happens when i run it


Sub DeleteMgrs()
Dim i As Long, j As Long, LastRow As Long
' First delete any empty rows
Call DeleteEmptyRows

' Count items in columns A
k = Application.CountA(Range("H2", Cells(Rows.Count, 8).End(xlUp)))

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False

For j = 1 To k
LastRow = ActiveSheet.UsedRange.Rows.Count
For i = LastRow To 1 Step -1
' MsgBox Cells(i, 4).Value
' MsgBox Cells(j + 1, 1).Value
If UCase(Trim(Cells(i, 4).Value)) = UCase(Trim(Cells(j + 1, 8).Value)) Then Range(Cells(i, 4), Cells(i, 6)).Delete shift:=xlUp
Next i
Next j

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
Sub DeleteEmptyRows()
'Deletes the entire row within the selection if the ENTIRE row
'contains no data.
Dim LastRow As Long, LastColumn As Long, r As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False

LastRow = ActiveSheet.UsedRange.Rows.Count
For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

 

[jacinthn]

got some paid help with modifying the coding, thanks again for all your help
solution code, see below

Sub DeleteMgrs()
Dim i As Long, LastRow As Long
Dim rngManager As Range, cell As Range

Application.ScreenUpdating = False

Set rngManager = Range("H2:H" & Range("H" & Rows.Count).End(xlUp).Row)
LastRow = Range("K" & Rows.Count).End(xlUp).Row

For i = LastRow To 2 Step -1
For Each cell In rngManager
If UCase(Replace(Cells(i, 11), " ", "")) = UCase(Replace(cell, " ", "")) Then Range(Cells(i, 11), Cells(i, 13)).Delete shift:=xlUp
Next cell
Next i

'Fix bottom border in case the last row was deleted
LastRow = Range("K" & Rows.Count).End(xlUp).Row
With Range("K" & LastRow & ":M" & LastRow).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Application.ScreenUpdating = True
End Sub