?
Solved

Highlight duplicate Rows and filter undu filter and highlight

Posted on 2011-03-22
11
Medium Priority
?
433 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:Michael Fowler
ID: 35196227
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
ID: 35196237
michael,
dups will be in column Q.

0
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35196312
You know you could do this with an additional formula column and an autofilter?
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 10

Assisted Solution

by:khan_webguru
khan_webguru earned 400 total points
ID: 35196343
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
ID: 35196348
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
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 35196484
0
 
LVL 3

Author Comment

by:Fordraiders
ID: 35198263
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 1600 total points
ID: 35203568
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
ID: 35203574
0
 
LVL 3

Author Closing Comment

by:Fordraiders
ID: 35208233
Thanks
0
 
LVL 3

Author Comment

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

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
Microsoft's Excel has many features that most people will never need nor take advantage of.  Conditional formatting is one feature that you may find a necessity once you start using it.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

755 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