Solved

Highlight duplicate Rows and filter undu filter and highlight

Posted on 2011-03-22
11
399 Views
Last Modified: 2012-08-13
excel 2003 vba

I need 2 functions to work form 2 command buttons


I have  a sheet that will at any given time have any number of rows...
except row1(column headers A1:AU1)

Duplicate values will be in COLUMN Q

The first command button will highlight the rows in yellow., and show only the rows in yellow via a filter.

2nd command will undo filter

I cannot buy an add-in program.

Thanks
fordraiders

0
Comment
Question by:fordraiders
  • 4
  • 2
  • 2
  • +2
11 Comments
 
LVL 23

Expert Comment

by:Michael74
Comment Utility
Will the duplicate rows all be the same value or will there be multiple values duplicated in column Q.

Michael
0
 
LVL 3

Author Comment

by:fordraiders
Comment Utility
michael,
dups will be in column Q.

0
 
LVL 85

Expert Comment

by:Rory Archibald
Comment Utility
You know you could do this with an additional formula column and an autofilter?
0
 
LVL 10

Assisted Solution

by:khan_webguru
khan_webguru earned 100 total points
Comment Utility
Dealing With Duplicate Records in Microsoft Excel

 Image 1
Finding With a Formula

1. 1

Use this method if you only need to get rid of duplicates once in a while.

1

We insert a new Column A by clicking on A and hitting InsertàColumn.

3

We give the row a heading. If we don't, and we sort the data, we might discombobulate it!

4

We type a formula into A2 that will find duplicates for us. This formula only looks for duplicate values in Column B.
 Image 2
If you need to look for duplicates in more than one column, you can use a formula like this one instead.



 Image 3

If you need to look for duplicates in more than one column, you can use a formula like this one instead.

 Image 4

We now sort descending by Column A to bring all the Dupes to the top.

 Image 5

Select all the rows that have "Dupe" in Column A, and delete them.

Delete Column A.

Finding With Conditional Formatting

Perhaps you only want to find the duplicate values so you can deal with each manually. For this you can use Conditional formatting. Just select the cells you want highlighted if there are duplicates. From the menu, choose FormatàConditional formatting. Choose the options as shown below, and type the formula in as shown, being sure to include the entire range of your cells.


 Image 6
Finding or Highlighting Using VBA

If you need to deal with duplicates often, you'll want to use VBA.

This entry deletes duplicates in a specified range. http://www.vbaexpress.com/kb/getarticle.php?kb_id=135

Chip Pearson provides many ways to deal with duplicates. http://www.cpearson.com/excel/duplicat.htm


I hope this will help you to solve your problem.

Regards,

Asif Ahmed Khan
0
 
LVL 10

Expert Comment

by:khan_webguru
Comment Utility
Hello Bro!

I also found some links that are performing same work that is required by you. Please find the links below:


http://www.excelfunctions.net/Excel-Duplicates.html

http://www.cpearson.com/excel/duplicates.aspx

http://www.ozgrid.com/Excel/highlight-duplicates.htm

http://www.computing.net/answers/office/excel-highlight-duplicate-entries/5159.html

Hope this will help you to solve your problem.

Regards,

Asif Ahmed khan
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 85

Expert Comment

by:Rory Archibald
Comment Utility
0
 
LVL 3

Author Comment

by:fordraiders
Comment Utility
very nice khan, Thanks
None address a sub routine or function to address my question of adding these behind command buttons or the fact that I will never know the amount of rows at any given time.

0
 
LVL 6

Accepted Solution

by:
rbrhodes earned 400 total points
Comment Utility
Hi.

"Can't buy an add in" None available for this, I suppose...

Try this out.  One sub to do it, another to undo it

Option Explicit

Sub FindDupes()

Dim msg
Dim i As Long
Dim roe As Long
Dim col As Long
Dim roe2 As Long
Dim col2 As Long
Dim c As Range
Dim cc As Range
Dim cel As Range
Dim rng As Range
Dim firstaddress As String

    On Error GoTo endo

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Clear old fill
    ActiveSheet.UsedRange.Interior.ColorIndex = xlNone

    'Where to scratch
    roe = ActiveSheet.UsedRange.Rows.Count
    col = ActiveSheet.UsedRange.Columns.Count + 1
    col2 = col + 1

    'Numbers for re-sort
    For i = 1 To 4
        Cells(i + 1, col) = i
    Next i
    Range(Cells(2, col).Address, Cells(5, col).Address).AutoFill _
      Destination:=Range(Cells(2, col).Address, Cells(roe, col).Address), Type:=xlFillDefault

    'Dupe col
    Set rng = Range("Q2:Q" & roe)

    'init
    i = 1
   
    'Check all
    For Each cel In rng
        With rng
            Set c = .Find(cel, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                Set cc = c
                firstaddress = c.Address
                Do
                    'Yellow fill
                    If c.Address <> firstaddress And Cells(c.Row, col2) = "" Then
                        Range(Cells(cc.Row, 1).Address, Cells(cc.Row, "AU").Address).Interior.ColorIndex = 6
                        Range(Cells(c.Row, 1).Address, Cells(c.Row, "AU").Address).Interior.ColorIndex = 6
                        'For dupe sort
                        Cells(c.Row, col2) = i
                        Cells(cc.Row, col2) = i
                    End If
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstaddress
               
            End If
        End With
        i = i + 1
    Next cel
   
    'Sort on Dupe sort
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range(Cells(2, col2).Address, Cells(roe, col2).Address), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range(Cells(2, 1).Address, Cells(roe, col2).Address)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'Original rows
    roe = Cells(Rows.Count, col).End(xlUp).Row
    'Dupe rows
    roe2 = Cells(Rows.Count, col2).End(xlUp).Row + 1
   
    'No dupes
    If roe2 = 2 Then
        msg = MsgBox("Congratulations, no duplicates found!", vbOKOnly + vbExclamation, "Unique values only")
    Else
        'Hide else
        If roe > roe2 Then
            Rows(roe2 & ":" & roe).EntireRow.Hidden = True
        End If
   
        'Clean up
         Columns(col).Hidden = True
        Columns(col2).Clear
    End If
   
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

    Set c = Nothing
    Set cc = Nothing
    Set cel = Nothing
    Set rng = Nothing

'Completed normally
Exit Sub

'Errored out
endo:
   
    msg = MsgBox("Error " & Err.Description, vbOKOnly + vbCritical, Err.Number)

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

    Set c = Nothing
    Set cc = Nothing
    Set cel = Nothing
    Set rng = Nothing

End Sub

Sub Undupe()

Dim col As Long
Dim roe As Long
   
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Where to scratch
    roe = ActiveSheet.UsedRange.Rows.Count
    col = ActiveSheet.UsedRange.Columns.Count - 1
   
    Columns(col).Hidden = False
    Rows.Hidden = False
   
    'Sort on Dupe sort
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range(Cells(2, col).Address, Cells(roe, col).Address), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range(Cells(1, 1).Address, Cells(roe, col).Address)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Columns(col).Clear
   
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub


http:\\www.members.shae.ca\ExcelVBA



0
 
LVL 6

Expert Comment

by:rbrhodes
Comment Utility
0
 
LVL 3

Author Closing Comment

by:fordraiders
Comment Utility
Thanks
0
 
LVL 3

Author Comment

by:fordraiders
Comment Utility
R B RHODES, just noticed that the "undupe" does not get rid of the colored cells(in "finddupe") ?
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now