Del dublicates

Jomu

New Member
Joined
Apr 19, 2011
Messages
13
Anyone who could help me.
That macro asks if I want to delete or not. If I choose "not" it leaves current cell red. How can I degree that. If I choose not to delete it should
leave that cell as it was in the begin. Please help me.

Sub oma()
Range("A:A").Interior.ColorIndex = xlNone
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If WorksheetFunction.CountIf(Range("A1:A" & i), Cells(i, 1).Value) > 1 Then
Cells(i, 1).Interior.ColorIndex = 3
If MsgBox("Duplicates highted...Do you want to delete", vbYesNo) = vbYes Then
Cells(i, 1).EntireRow.Delete
End If
End If
Next i
End Sub
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Sub oma()
Range("A:A").Interior.ColorIndex = xlNone
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If WorksheetFunction.CountIf(Range("A1:A" & i), Cells(i, 1).Value) > 1 Then
Cells(i, 1).Interior.ColorIndex = 3
If MsgBox("Duplicates highted...Do you want to delete", vbYesNo) = vbYes Then
Cells(i, 1).EntireRow.interior.colorindex=xlnone
Cells(i, 1).EntireRow.Delete
End If
End If
Next i
End Sub
 
Upvote 0
Hi. Thanks for the answer. However Your code still leaves cell red. That is just I do not want.
 
Upvote 0
hth

Cheers

Dave

Code:
Sub oma()
    Range("A:A").Interior.ColorIndex = xlNone
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If WorksheetFunction.CountIf(Range("A1:A" & i), Cells(i, 1).Value) > 1 Then
            Cells(i, 1).Interior.ColorIndex = 3
            If MsgBox("Duplicates highted...Do you want to delete", vbYesNo) = vbYes Then
                Cells(i, 1).EntireRow.Delete
            Else
                 Cells(i, 1).Interior.ColorIndex = xlNone
            End If
        End If
    Next i
End Sub
 
Upvote 0
Thanks Breddtj

Thank You very much. This was just what I want to. However, is there any possibilty to add "cancel" to code, while searching duplicates from the sheet ?
Greetings from Finland.:laugh:
 
Upvote 0
No probs

Sure, try this update

Code:
Sub oma()
Dim lngSel As Long
    Range("A:A").Interior.ColorIndex = xlNone
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If WorksheetFunction.CountIf(Range("A1:A" & i), Cells(i, 1).Value) > 1 Then
            Cells(i, 1).Interior.ColorIndex = 3
            lngSel = MsgBox("Duplicates highted...Do you want to delete", vbYesNoCancel)
            If lngSel = vbCancel Then Exit Sub
            If lngSel = vbYes Then
                Cells(i, 1).EntireRow.Delete
            Else
                 Cells(i, 1).Interior.ColorIndex = xlNone
            End If
        End If
    Next i
End Sub
 
Upvote 0
Thanks again. You are a MAN....

How about, is it possible that code goes throw not just A column but also B and C:s ? Kind regards






No probs

Sure, try this update

Code:
Sub oma()
Dim lngSel As Long
    Range("A:A").Interior.ColorIndex = xlNone
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If WorksheetFunction.CountIf(Range("A1:A" & i), Cells(i, 1).Value) > 1 Then
            Cells(i, 1).Interior.ColorIndex = 3
            lngSel = MsgBox("Duplicates highted...Do you want to delete", vbYesNoCancel)
            If lngSel = vbCancel Then Exit Sub
            If lngSel = vbYes Then
                Cells(i, 1).EntireRow.Delete
            Else
                 Cells(i, 1).Interior.ColorIndex = xlNone
            End If
        End If
    Next i
End Sub
 
Upvote 0
Hi. Is it possible that code shows which items are dublicates. I mean that I have made a button where macro exist and when i push that button macro starts. How ever it start from the bottom of the worksheet and goes upward. When the duplicate has been found it gives a message but doesnt show that row where dublicates are found. Buttons are at the top of the worksheet and those rows where buttons are are locked. I can send an example if it helps. :laugh:
 
Upvote 0

Forum statistics

Threads
1,223,247
Messages
6,171,004
Members
452,374
Latest member
keccles

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
Back
Top