How can I get this output using excel VBA

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:

=AGGREGATE(14,4,($E$2:$E$9=G2)*$C$2:$C$9,1)

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 😉)


UPDATE

@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
    Next
    
    ' clear result range before filling
    Set UniqueRange = range(resultDataRange)
    UniqueRange.Clear
    
    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
    
    Next
    
    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
        
    Next

    'fix date formatting
    Columns("C:C").Select
    Selection.NumberFormat = "m/d/yyyy"

    ' Set the selected cell
    Range("A1").Select

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:

range(resultDataRange).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

range(keyRange).Select
Application.CutCopyMode = False
Selection.ClearContents

range(resultKeyRange).Select
Application.CutCopyMode = False
Selection.ClearContents

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.

Enjoy!