Filtering out duplicates or unique Entries....HELP!!!

[spunkeymonkey]

I have a project that I need to submit to my Manager tomorrow, and am at my wits end trying to accomplish something that I know should be straight forward.

Using Excel 97, I have been trying to use the AdvanceFilter as well as formulas found through online searches, but I simply cannot achieve the results I am looking for.

Below is a simplified look at my excel situation:

A B C D

1 3 3 6
2 8 0 3
3 5 7 4
4 2 4 0
5 0 9 2

I have four companies (A, B, C & D) which I need to bill for each active employee (represented here by numbers ranging from 0 to 9). Some employees may appear in two or more of the companies, but I only need to account for them ONCE (thus, eliminate any duplications).

What I need is a reprentation of unique entries, and I can't figure out how to use the Advance Filter feature or another Excel option to accomplish the following results of unique employee entries (in the same format as above obviously):

Company A should show the following unique entries: 1, 2, 3, 4, 5
Company B should show the following unique entries: 8, 0
Company C should show the following unique entries: 7, 9
Company D should show the following unique entries: 6

Either, I would like a new column of unique entries (I would just bill cumulatively for 10 employees) OR for duplicates to be deleted (I could then breakdown the billing--Company A for five people, Company B for two people, Company C for two and Company D for one).

S.O.S Someone if you could HELP!
I need a Step by Step because I am obviously missing something in my previous attempts

 

[sweater_vests_rock]

spunkey.

welcome to the board!

when you filter by unique employees, does it matter to which company they are assigned? that is, in your example, employee 3 is listed under all four companies, but they have been designated as a unique employee only for company A. how was this chosen? do you want to always move left to right? top to bottom? alphabetical order? some other technique?

thanks. ben.

 

[dcdewick]

try this link

http://www.cpearson.com/excel/duplicat.htm#HighlightingDuplicates

 

[spunkeymonkey]

Hey Ben

No, it really doesn't matter where the employee appears, as long as it is only ONCE.

Sure, ideally, I would like Company A to be the starting point from which the comparison is done (Company A happens to be the parent company while B, C & D are divisions of A). Thus, as you suggested moving right.

If that is possible (and reasonable easy to do) that would be great. But it is not necessary.

Thanks so much for any help that you can send my way

 

[al_b_cnu]

Hi Ben, Try this macro:

Sub RemoveDups()
Dim iCol As Integer, iCol1 As Integer
Dim lRow As Long, lRowEnd As Long
Dim vCur As Variant, vResult As Variant
Dim WS As Worksheet

Set WS = Sheets("Sheet1")
lRowEnd = WS.UsedRange.Rows.Count

For iCol = 2 To WS.Cells(1, Columns.Count).End(xlToLeft).Column
    For lRow = lRowEnd To 2 Step -1
        vCur = WS.Cells(lRow, iCol).Value
        On Error Resume Next
        For iCol1 = 1 To iCol - 1
            vResult = "*"
            vResult = WorksheetFunction.Match(vCur, _
                                              Range(Cells(2, iCol1).Address, _
                                              Cells(lRowEnd, iCol1).Address), 0)
            If IsNumeric(vResult) Then
                If lRow <> lRowEnd Then
                    WS.Range(Cells(lRow, iCol).Address, Cells(lRowEnd - 1, iCol).Address).Value = _
                        WS.Range(Cells(lRow + 1, iCol).Address, Cells(lRowEnd, iCol).Address).Value
                End If
                WS.Cells(lRowEnd, iCol).ClearContents
                Exit For
            End If
        Next iCol1
        On Error GoTo 0
    Next lRow
Next iCol
End Sub

which deletes duplicates in situ

Assumptions are:
Data is in Sheet1, & starts in row 2.

 

[spunkeymonkey]

Hey dcdewick

Thanks for the link. I think it may have solved my dilemma.

My original scenerio of four companies with lists of employees:

A B C D

1 3 3 6
2 8 0 3
3 5 7 4
4 2 4 0
5 0 9 2



I Placed Company A employee list in column A2:A6), and Company B employee list in column B2:B6). In column C I entered the following formula =IF(COUNTIF($A$2:A6,B2)=0,B2,"") from C2:C6. The results, will be the employees I bill Company B.

I repeated the process comparing the results from C2:C6 to Company C employee list in column D2:D6.The results in cloumn E will be the employees I bill Company C.

I repeated the process comparing the results in E2:E6 to Company D employee list in column F2:F6.The results in cloumn G, will be the employees I bill Company D.

Finally, in A7, C7, E7, G7 in put the following formula =COUNTIF(A2:A6,"??") which gives me the employee count for each company.

Thanks
spunkey

If anyone knows a simplier approach (as I have no clue how to use macros), I would more than welcome and appreciate the input.

 

[sweater_vests_rock]

a programmatic solution

spunkey.

this is tailored to your example, and should work for all cases in which each company has a corresponding employee column.

let me know if you have any problems or questions.
ben.

Enum InputBoxConstants
    xlText = 2
    xlRange = 8
End Enum


Sub FilterUniqueEmployees()
    Dim CompanyRange As Range, NewCompanyRange As Range
    Dim EmployeeRange As Range, NewEmployeeRange As Range
    Dim SourceSheet As Worksheet, TempSheet As Worksheet

'   Gets company and employee ranges from the user
    On Error GoTo CompanyError
    Set CompanyRange = Application.InputBox("Please select the company names:", Title:="Get Company Name Range", Type:=xlRange)
        
    On Error GoTo EmployeeError:
    Set EmployeeRange = Application.InputBox("Please select the employees to filter:", Title:="Get Employee Range", Type:=xlRange)
    
'   Ensures ranges are of equal width
    If EmployeeRange.Columns.Count <> CompanyRange.Columns.Count Then
        MsgBox "Each company must have a unique column.  Program ending..."
        Exit Sub
    End If
    
'   Establishes the activesheet as the datasheet
    Set SourceSheet = ActiveSheet
    
    Application.ScreenUpdating = False
    
'   Creates single row ranges from row/column ranges on temp sheet
    Call ConsolidateColumns(SourceSheet, TempSheet, CompanyRange, EmployeeRange, NewCompanyRange, NewEmployeeRange)

'   Creates unduplicated row range from row ranges containing duplicates
    Call ConsolidateDuplicates(TempSheet, NewCompanyRange, NewEmployeeRange)

'   Copies unduplicated row range into source sheet and removes temp sheet
    Call InsertUniques(SourceSheet, TempSheet, CompanyRange, NewCompanyRange, NewEmployeeRange)
    
    Application.ScreenUpdating = True
    Exit Sub

'   Handles invalid range entries
CompanyError:
    If CompanyRange Is Nothing Then
        MsgBox "Invalid company name range.  Program ending..."
        Exit Sub
    End If

'   Handles invalid range entries
EmployeeError:
    If EmployeeRange Is Nothing Then
        MsgBox "Invalid employee range. Program ending..."
    End If
End Sub

Private Sub ConsolidateColumns(SourceSheet As Worksheet, TempSheet As Worksheet, CompanyRange As Range, EmployeeRange As Range, NewCompanyRange As Range, NewEmployeeRange As Range)
    
    Dim i As Integer

'   Counts the number of employees per company
    EmployeeRows = EmployeeRange.Rows.Count
    
'   Creates a temp sheet for data manipulation
    Set TempSheet = ThisWorkbook.Worksheets.Add
    TempSheet.Name = "TEMP" & ThisWorkbook.Worksheets.Count
    
    For i = 1 To EmployeeRange.Columns.Count
        
'       Copies Employees by company column into a single column in the temp sheet
        SourceSheet.Activate
        EmployeeRange.Range(Cells(1, i), Cells(EmployeeRows, i)).Copy
        TempSheet.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial
        
'       Copies the corresponding compnay name into a single column in the temp sheet
        CompanyRange.Cells(1, i).Copy
        With TempSheet
            .Activate
            .Range(Cells(Rows.Count, 1).End(xlUp).Offset(1, 1), Cells(Rows.Count, 2).End(xlUp)).Offset(0, -1).PasteSpecial
        End With
        
    Next i
               
    TempSheet.Cells(1, 1) = "COMPANY NAME"
    TempSheet.Cells(1, 2) = "UNIQUE EMPLOYEES"
               
    Set NewCompanyRange = TempSheet.Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
    Set NewEmployeeRange = NewCompanyRange.Offset(0, 1)
           
    Application.ScreenUpdating = True
    
End Sub

Private Sub ConsolidateDuplicates(TempSheet As Worksheet, NewCompanyRange As Range, NewEmployeeRange As Range)

    Dim CountRange As Range
    Dim i As Long, j As Long

'   Sorts the ranges by the employee name/code
    NewEmployeeRange.Offset(1, 0).EntireRow.Sort Key1:=Cells(1, 2), Order1:=xlAscending

'   Creates a count range which counts the number of times an employee is listed
    Set CountRange = NewEmployeeRange.Offset(0, 1)
    
    With CountRange
        .Cells(1, 1).Value = "COUNT RANGE"
        .Offset(1, 0).Resize(CountRange.Rows.Count - 1, 1).Formula = "=COUNTIF(" & NewEmployeeRange.Address(ReferenceStyle:=xlR1C1) & ", RC[-1])"

'   Deletes duplicate employee entries from the count range
        For i = 2 To .Rows.Count - 1
            With .Cells(i, 1)
                If .Value <> "" Or .Value <> 1 Then
                    For j = 1 To .Value - 1
                        .Offset(j, 0).Value = ""
                    Next j
                End If
            End With
        Next i

'   Deletes duplicate entries from all ranges
        For i = .Rows.Count - 1 To 2 Step -1
            If .Cells(i, 1) = "" Then .Cells(i, 1).EntireRow.Delete
        Next i

'   Deletes the count range
        .EntireColumn.Delete
    End With
    
'   Sorts consolidated ranges by the Company Name
    NewCompanyRange.Offset(1, 0).EntireRow.Sort Key1:=Cells(1, 1), Order1:=xlAscending
    
End Sub

Private Sub InsertUniques(SourceSheet As Worksheet, TempSheet As Worksheet, CompanyRange As Range, NewCompanyRange As Range, NewEmployeeRange As Range)

    Dim CopyRange As Range

'   Creates range housing consolidated company and employee ranges
    Set CopyRange = Union(NewCompanyRange.EntireColumn, NewEmployeeRange.EntireColumn)

'   Copies range to inserted columns in the source sheet
    CopyRange.Copy
    SourceSheet.Activate
    CompanyRange.Offset(0, CompanyRange.Columns.Count + 1).Resize(1, 1).Insert Shift:=xlShiftRight
    
'   Deletes the temporary worksheet
    Application.DisplayAlerts = False
    TempSheet.Delete
    Application.DisplayAlerts = True
    
End Sub

 

[spunkeymonkey]

Programs for dummies

Wholly Crypton Ben!

Okay...for someone who would like to think they know alot about EXCEL but obvious I do not. Is what you gave me a macro or mini program or something?

If I have my EXCEL worksheet open with the data I have been describing, my first step would be to...? What? Highlight all columns? Go to Tools-->Macros?

I apologize if this is one of those idiot questions that people hate in their forums but if you could extend just a little patience with me. Can you take me through the steps needed to run the program. And, will it matter whether a I have six rows as my hypothetical demonstrates or over 8000 as the true scenerio contains? Is there any adjsutment I will need to make to the program?

Thanks
spunkey

I promise I will be singing your praises when I submit the completed project tomorrow (well likely not...we all need to look like a superstar for our boss at least once a year :wink: )

 

[sweater_vests_rock]

spunkey.

these are all good questions, esp. about the extensibility of the program; that is, i can tell you the code can handle any number of rows and 253 columns without any errors, but i can't make any promises on speed. but more on that later.

to input this code into your workbook, use the keyboard combo ALT+F11. this will pull up the VBEditor.

once in the VBEditor, you need to goto the Projects Explorer (shortcut key CTRL+R if you can't find it). on my computer, this is a window in the upper-left side of the screen. this window lists your open Excel Workbooks and add-ins, much like Explorer shows your harddrives file structure. find the Project which corresponds to your current workbook (Project[MyFileName].xls).

once you have located the proper Project, you need to add a new module. you can do this with the toolbar Insert -> Module. this should pull up a blank white page similar to Microsoft Notebook. this is where you will need to paste my code from the forum. because long lines are textwrapped occasionally when posting, you might need to adjust these upon pasting (indicated by lines in red).

i'm not sure how much you know about VBA (i'm guessing not much), but i've tried to put some basic comments in the code to help you follow how the program is working. i've also tried to name my variables in a way that facilitates easy understanding, but i suppose that is only my subjective opinion. if you have any specific questions, i would be happy to help as i am able.

regarding extensibility:
to be honest, i couldn't really say how well this would work with large datasets, in the respect that it is difficult to gauge the impact on speed (esp. without a large dataset handy!). i can tell you that i had to use a couple of loops so as to maintain employee/company connectivity, which is hardly ever the best way to move data. on the other hand, i didn't use it everytime i was manipulating things. let me take a look again at the code to see if i can be doing things more effectively.

hope this helps. ben.

 

[spunkeymonkey]

muchas gracias programming wizard

The fact that you are explaining this stuff to me is a huge help.

You're instuctions are dummy proof, and I followed everything successfully up to the paste. I paste the "code" into the...(referring back to your post) module, and the following lines appear in red at the very beginning:

Enum InputBoxConstants
xlText = 2
xlRange = 8
End Enum

As you are spot on in your conclusions ( "i'm not sure how much you know about VBA (i'm guessing not much)," ), I'm not sure sure how I am suppose to "adjust these lines. Assistance, s'il vous plait (please).

Once that is corrected, I do what exactly?...Again, I feel like a nob asking, but thank you for the patience. I hope this process may prove helpful to some other nimb-rod like me who is having similar problems.

spunkey