VBA to delete duplicate rows but save the one with the highest value.

[Kwinger]

I am fairly new to VBA. I am in need of a macro that will delete duplicate rows in column 'A' while keeping the highest value from those duplicates in column 'F'. I have researched and tried several from different posts on this site and various from random internet sites but am coming up short. Any help would be greatly appreciated.

 

[Kwinger]

I am fairly new to VBA. I am in need of a macro that will delete duplicate rows in column 'A' while keeping the highest value from those duplicates in column 'F'. I have researched and tried several from different posts on this site and various from random internet sites but am coming up short. Any help would be greatly appreciated.

This is an example of what I am looking for. The data set can sometimes be 1000's of rows and the columns sometimes vary based on sheet but, column 'A' and column 'F' will always be the data I need to sort and delete.

 

[Rhodie72]

I think that te answer is quite simple

Sub Find_Duplicates_Remove_Smallest_Values()
Application.ScreenUpdating = False
    Dim First As String, Second As String
Range("A1").Select
    While ActiveCell.Offset(1, 0) <> 0
        If ActiveCell.Value = ActiveCell.Offset(1, 0) Then
           First = ActiveCell.Offset(0, 5).Value
           Second = ActiveCell.Offset(1, 5).Value
           If First < Second Then
'                MsgBox "First<Second, removing  smallest number row", vbExclamation
                ActiveCell.EntireRow.Delete
            Else
'                MsgBox "First<Second, removing  smallest number row", vbExclamation
                ActiveCell.Offset(1, 0).EntireRow.Delete
            End If
        Else
            ActiveCell.Offset(1, 0).Activate
        End If
    Wend
    MsgBox "No more values to check", vbInformation, ActiveCell.Value
Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

Welcome to the MrExcel board!

For the future, please consider the following for providing sample data as we can then easily copy it for testing.
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

From your picture, it appears that the 'numbers' in column F may actually be text values as they are left aligned. If that is the case then try the code as given below. If they are actually numbers then you could swap the formula line to the commented alternative I have provided.

In any case, test with a copy of your data.

I have assumed that column Z is available to use as a helper. You could swap that to any other column if you want/need.

Sub KeepHighest()
  Dim lr As Long
  
  lr = Range("A" & Rows.Count).End(xlUp).Row
  With Range("Z1:Z" & lr)
    .Formula = Replace("=IF(F1+0=AGGREGATE(14,6,(F$1:F$#+0)/(A$1:A$#=A1),1),"""",1)", "#", lr)
'    .Formula = Replace("=if(F1=MAXIFS(F$1:F$#,A$1:A$#,A1),"""",1)", "#", lr)
    On Error Resume Next
    .SpecialCells(xlFormulas, xlNumbers).EntireRow.Delete
    On Error GoTo 0
    .ClearContents
  End With
End Sub