Click here to Skip to main content
15,746,652 members
Please Sign up or sign in to vote.
0.00/5 (No votes)
See more:
Excel column "A" more than Duplecate Names(in Different locations same Company Name),
Column "B" Person Name, C  Column Date given.

Company Name	Per Name		Date
A Column		B Column		C Column

ABC Company		aaaa		12/01/2022	
ABC Company		aaaa		14/01/2023
ABC Company		bbbb		15/02/2023

CDE Company		eeee		16/07/2023

EFG Company		ffff		12/02/2022
EFG Company		ffff		24/03/2023

i need this OutPut

ABC Company		aaaa		14/01/2023
ABC Company		bbbb		15/02/2023
CDE Company		eeee		16/07/2023
EFG Company		ffff		24/03/2023

how can i get this output using Excel VBA

What I have tried:

ub Highlighting_Comparing_2Columns()
Dim Twocolumns As Range, i As Integer

Set Twocolumns = Selection

With Twocolumns
  For i = 1 To .Rows.Count
    If Not StrComp(.Cells(i, 1), .Cells(i, 2), vbBinaryCompare) = 0 Then
      Range(.Cells(i, 1), .Cells(i, 2)).Interior.ColorIndex = 6
    End If
  Next i
End With

End Sub
Updated 19-Apr-23 16:02pm

You can do this without using a VBA macro. We do need to add an key column by combining Col A with Col B (=A2&B2) for each row. eg: next row will be: =A3&B3 and so on....

Now we can filter unique companies. I will use a non-CSE (CTRL-SHIFT-ENTER) array formula:
=IFERROR(INDEX($E$2:$E$9, MATCH(0,INDEX(COUNTIF($G$1:G1,$E$2:$E$9),0,0),0)), "")

This will need to be done to several rows to find all unique values. How it works is by using the key column value and comparing it to the row above it.

Now that we have all of the unique keys, we can now look for the max dates. This is a little more involved. We will be using the AGGREGATE function. This will need to be applied to each cell next to the unique results:

Okay, so, let us break down what this is doing:
1. 14 = Large / largest date value
2. 4 = Ignore Nothing
3. ($E$2:$E$9=G2) = for all matching key rows
4. *$C$2:$C$9 = for all dates
5. (3. & 4.) ($E$2:$E$9=G2)*$C$2:$C$9 = Logical test for only date cells that match the keys for steps 3., 4. 5., select the formula part in the edit formula bar and press the F9 key to see the array test true/false values. Multiplying booleans with booleans returns booleans ie: multiply a true (1) with a true (1), and you get true (1 x 1 = 1); multiply a False (0) with a True (1) or False(0) you get False (0 x 1 = 0 or 0 * 0 = 0)
6. 1 = the [k] selector is set for the first result

Here is a link to the solution: Unique Companies with max date.xlsx | Google Drive[^]. I have not hidden any rows or columns + I have added wrappers to the formulas to hide any errors or cells with results that we do not want to see. So they appear empty.

NOTE: Google Drive will want to open the spreadsheet in Google Sheets. If this happens, Google Sheets does not support the Aggregate function and will throw a #Name? error. Do not worry, Select from the menu File > Download > Microsoft Excel. Now open the downloaded spreadsheet in Excel and it will work as expected. (I just tested this 😉)


@Maciej Los suggested that a VBA solution was required, but gave an incomplete solution. So here is a complete VBA solution based on the above formulas...

Sub CompareAndCopy()

    Dim selectRange As String
    Dim keyRange As String
    Dim resultKeyRange As String
    Dim companyRange As String
    Dim nameRange As String
    Dim dateRange As String
    Dim expandedRange As String
    Dim resultDataRange As String
    Dim dateCell As String
    Dim resultIndex As Integer
    Dim selRange As range
    Dim UniqueRange As range
    Dim index As Integer
    ' If using dynamic range, ie, as rows are added, you expand the range,
    ' then these values need to change
    selectRange = "$A$2:$C$7"
    keyRange = "$D$2:$D$7"
    companyRange = "$A$2:$A$7"
    nameRange = "$B$2:$B$7"
    dateRange = "$C$2:$C$7"
    expandedRange = "$A$2:$D$7"
    resultIndex = 8 'header row number for results
    resultKeyRange = "$D$9:$D$16"
    resultDataRange = "$A$9:$D$16"
    Set selRange = range(selectRange)
    For Each Row In selRange.Rows
        If Row.Cells(1, 1) <> "" Then
            Row.Offset(0, 3).Cells(1, 1) =
                Row.Cells(1, 1) + Row.Cells(1, 2)
        End If
    ' clear result range before filling
    Set UniqueRange = range(resultDataRange)
    Set UniqueRange = range(resultKeyRange)
    index = resultIndex ' see note above regarding dynamic range
    For Each cell In UniqueRange.Rows
        cell.Formula = "=IFERROR(INDEX(" + keyRange + _
            ", MATCH(0,INDEX(COUNTIF($D$8:D" + CStr(index) + _
            "," + keyRange + "),0,0),0)), """")"
        index = index + 1
    Set selRange = range(expandedRange)
    Set UniqueRange = range(resultDataRange)
    index = resultIndex + 1 ' see note above regarding dynamic range
    For Each Row In UniqueRange.Rows
        dateCell = "$D" + CStr(index)
        If Not IsEmpty(range(dateCell).Value) Then
            Row.Offset(0, 0).Cells(1, 1).Formula = "=IF(" + dateCell + _
                " <> """",INDEX(" + companyRange + 
                ",MATCH(" + dateCell + "," + keyRange + ",0)), """")"

            Row.Offset(0, 1).Cells(1, 1).Formula = "=IF(" + dateCell + _
                " <> """",INDEX(" + nameRange + 
                ",MATCH(" + dateCell + "," + keyRange + ",0)), """")"

            Row.Offset(0, 2).Cells(1, 1).Formula = "=IF(" + dateCell + _
                " <> """",AGGREGATE(14,4,(" + keyRange +
                "=" + dateCell + ")*" + dateRange + ",1), """")"
            index = index + 1
        End If

    'fix date formatting
    Selection.NumberFormat = "m/d/yyyy"

    ' Set the selected cell

End Sub

If you want to remove the keys and make the results static data (values, not formulas) then you could add this at the end:
Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Application.CutCopyMode = False

Spreadsheet link updated with the new VBA macro is: Unique Companies with max date.xlsm - Google Drive[^] ... again, opens like a Google Sheet and there is a Download button in the top right corner. 😉

Download and have a look to see how it works.

Share this answer
Maciej Los 19-Apr-23 10:30am    
A 4, because there's tons of reasons to avoid using 'Select' method.
Have a nice day, Greame :)
If i understand you well, you want to get the last entry for each company and location based on date.

You need to sort data by company name, location in ascending order and a date in the descending order. Then you need get the first row for each company name and location. How? The simplest way is to use a Dictionary object[^].
Before you use below code, go to the menu Tools=>References (in a Code pane: ALT+F11) and add reference to the "Microsoft Scripting Runtime".

Sub CompareAndCopy()
    Dim wshSrc As Worksheet, wshDst As Worksheet, oDic As Dictionary
    Dim i As Long, j As Long, sKey As String

    Set wshSrc = ThisWorkbook.Worksheets(1)
    Set wshDst = ThisWorkbook.Worksheets(2)
    Set oDic = New Dictionary
    i = 2
    j = 2
    Do While wshSrc.Range("A" & i) <> ""
        sKey = wshSrc.Range("A" & i) & wshSrc.Range("B" & i)
        If Not oDic.Exists(sKey) Then
            oDic.Add sKey, i
            wshSrc.Range("A" & i & ":C" & i).Copy wshDst.Range("A" & j)
            j = j + 1
        End If
        i = i + 1
    Set oDic = Nothing
    Set wshSrc = Nothing
    Set wshDst = Nothing

End Sub

Above code does not contain a method to sort data. This is the part you have to do.

Good luck!
Share this answer
Graeme_Grant 18-Apr-23 16:42pm    
Bah ... VBA not needed 😛😂
Maciej Los 18-Apr-23 16:54pm    
Of course, but OP wanted to use VBA.
Graeme_Grant 18-Apr-23 16:58pm    
VBA is used when they can't figure out the right formula solution. In this case, there are 2 solutions, one CSE, and one non-CSE. Non-CSE is easier for most.
Maciej Los 18-Apr-23 17:03pm    
It's your point of view...
BTW: What is CSE and non-CSE solution?
Graeme_Grant 18-Apr-23 17:10pm    
Not opinion, based on my experience... BTW, did you download the spreadsheet to see how it worked?

The second paragraph in my solution: "non-CSE (CTRL-SHIFT-ENTER)" array formula...

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900