Replace Data with VBA

Option Explicit


Sub ReplaceDuplicate(ByVal sRange As Range)
Dim oData
Dim i As Long, j As Long, k As Long, iMaxRows As Long, iMaxCols, iLastRow As Long
'get the data and dimensions
    oData = sRange.Value2
    iMaxRows = UBound(oData, 1)
    iMaxCols = UBound(oData, 2)
    
'for each row check for duplicates
    For i = 2 To iMaxRows - 1
        For j = i + 1 To iMaxRows
            If oData(i, 1) <> "" And oData(i, 1) = oData(j, 1) And oData(i, 2) = oData(j, 2) Then
                'found it so swap it
                For k = 3 To iMaxCols
                    oData(i, k) = oData(j, k)
                Next k
                
                'erase it
                For k = 1 To iMaxCols
                    oData(j, k) = ""
                Next k
            End If
        Next j
    Next i
    
'bump up blank lines
    For i = 2 To iMaxRows - 1
        If oData(i, 1) = "" Then
            j = i + 1
            While oData(j, 1) = "" And j < iMaxRows
                j = i + 1
            Wend
            
            For k = 1 To iMaxCols
                oData(i, k) = oData(j, k)
                oData(j, k) = ""
            Next k
        End If
    Next i
    
'dump it back
    sRange.Value = oData
    
End Sub


Sub test()
    Call ReplaceDuplicate(Range("Sheet1!A1:D7"))   'Obviously you will need to edit this for the range you need
End Sub

Public Sub ReformatData()
Dim names As String
Dim dates As String
Dim times As String
Dim formula As String
Dim lastrow As Long
Dim otherrow As Long
Dim i As Long


    Application.ScreenUpdating = False
    
    With ActiveSheet
    
        lastrow = .Range("A1").End(xlDown).Row
        names = .Range("A1").Resize(lastrow).Address
        dates = .Range("B1").Resize(lastrow).Address
        times = .Range("C1").Resize(lastrow).Address
        formula = "MATCH(1,(" & names & "=A<row>)*(" & dates & "=B<row>)*(" & times & "=C<row>),0)"
        For i = lastrow To 2 Step -1
        
            otherrow = .Evaluate(Replace(formula, "<row>", i))
            If otherrow <> i Then
            
                .Cells(otherrow, "D").Value = .Cells(i, "D").Value
                .Rows(i).Delete
            End If
        Next i
    End With
    
    Application.ScreenUpdating = True
End Sub

Sub M_snb()
   Sheet2.[K1] = Join(Application.Index(Sheet2.Cells(Rows.Count, 1).End(xlUp).Resize(, 3).Value, 1, 0), "")
   Sheet2.Cells(Val(Replace(Trim(Join(Filter([transpose(if(sheet2!A1:A100="","~",if(sheet2!A1:A100&sheet2!B1:B100&sheet2!C1:C100=K1,row(1:100),"~")))], "~", False))), " ", "|")), 4) = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(, 3).Value
   Sheet2.[K1] = ""
End Sub