Count duplicates,then remove them as they are entered

try

Private Sub UnosPodataka()
    Dim dic As Object:  Set dic = CreateObject("Scripting.Dictionary")
    Dim Unos$, dKey, i&
    Dim LastRow&
    With Sheet2
        LastRow = .UsedRange.Rows.Count + .UsedRange.Row    'last row of data
        
        For i = 2 To LastRow      'scan existing data
            If Not IsEmpty(.Cells(i, 1)) Then
                dKey = .Cells(i, 1).Value & "," & .Cells(i, 2).Value
                If dic.exists(dKey) Then
                    dic(dKey) = CInt(Split(dic(dKey), "~")(0)) + 1 & "~" & CInt(Split(dic(dKey), "~")(1))
                Else
                    dic(dKey) = "1~" & i
                End If
            End If
        Next i
        
        Do
            Unos = InputBox("Unesi podatke", "Unos podataka", "Strelac,Vlasnik")
            If Unos = "" Then Exit Do
            If dic.exists(Unos) Then
                dic(Unos) = CInt(Split(dic(Unos), "~")(0)) + 1 & "~" & CInt(Split(dic(Unos), "~")(1))
                .Cells(CInt(Split(dic(Unos), "~")(1)), 3) = CInt(Split(dic(Unos), "~")(0))
            Else
                dic(Unos) = "1~" & LastRow
                If InStr(Unos, ",") Then
                    .Range("A" & LastRow & ":C" & LastRow).Value = Array(Split(Unos, ",")(0), Split(Unos, ",")(1), CInt(Split(dic(Unos), "~")(0)))
                Else
                    .Range("A" & LastRow & ":C" & LastRow).Value = Array(Unos, vbNullString, CInt(Split(dic(Unos), "~")(0)))
                End If
                LastRow = LastRow + 1
            End If
        Loop Until Unos = ""
    End With
End Sub

add

dic.CompareMode = vbTextCompare

somewhere above the first loop