Solved

Highlight duplicate Rows and filter undu filter and highlight

Posted on 2011-03-22
11
419 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

 
LVL 10

Assisted Solution

by:khan_webguru
khan_webguru earned 100 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 400 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

Salesforce Has Never Been Easier

Improve and reinforce salesforce training & adoption using WalkMe's digital adoption platform. Start saving on costly employee training by creating fast intuitive Walk-Thrus for Salesforce. Claim your Free Account Now

Question has a verified solution.

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

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 article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

688 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