Can anyone change this VBA code has per my request

[Prasad K]

i have data in my sheet with duplicates in Col A Col B Col C Col D Col E i want to copy only unique values data from sheet1 to sheet2 has per same columns

i have found some vba code this code is working perfectly to me i have some small problem this below code is copying unique value data to Column F & my question is this code will copy unique data to sheet2 of Col A to Col E​

--------------------------------------------------------------------------------------------------------------------
Sub uniKue()
Dim i As Long, N As Long, s As String
N = Cells(Rows.count, "A").End(xlUp).Row
For i = 2 To N
Cells(i, 6) = Cells(i, 1) & " " & Cells(i, 2) & " " & Cells(i, 3) & " " & Cells(i, 4) & " " & Cells(i, 5)
Next i

Range("F2:F" & N).RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
--------------------------------------------------------------------------------------------------------------------

 

[Prasad K]

I misunderstood. try this formula at F2 and Drag it down:

=COUNTIFS(Sheet1!$A$2:$A$16,A2,Sheet1!$B$2:$B$16,B2,Sheet1!$C$2:$C$16,C2,Sheet1!$D$2:$D$16,D2,Sheet1!$E$2:$E$16,E2)

Or use this code:

Sub DelDupl()
Dim Ws1 As Worksheet, Ws2 As Worksheet, N As Long
  Set Ws1 = Sheets("sheet1")
  Set Ws2 = Sheets("sheet2")
  N = Ws1.Cells(Rows.Count, "A").End(xlUp).Row
  Ws2.Range("A1:E" & N).Value = Ws1.Range("A1:E" & N).Value
  Ws2.Range("A2").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlNo
  Range("F2").FormulaR1C1 = "=COUNTIFS(Sheet1!R2C1:R" & N & "C1,RC[-5],Sheet1!R2C2:R" & N & _
  "C2,RC[-4],Sheet1!R2C3:R" & N & "C3,RC[-3],Sheet1!R2C4:R" & N & "C4,RC[-2],Sheet1!R2C5:R" & N & "C5,RC[-1])"
    Range("F2").AutoFill Destination:=Range("F2:F8"), Type:=xlFillDefault
   
 
End Sub

Once again Thankyou for your help

 

[veyselemre]

Hi,
Do you want to see such a result?

Sub test()
    Dim s1 As Worksheet, s2 As Worksheet, lR As Long
    Dim data, yData, i&, ii&, krt$, say&, sira&
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    lR = s1.Cells(Rows.Count, 1).End(3).Row
    data = s1.Range("A1:E" & lR).Value
    ReDim yData(1 To UBound(data), 1 To UBound(data, 2) + 1)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(data)
            krt = ""
            For ii = 1 To UBound(data, 2)
                krt = krt & "|" & data(i, ii)
            Next ii

            If Not .exists(krt) Then
                say = say + 1
                For ii = 1 To UBound(data, 2)
                    yData(say, ii) = data(i, ii)
                Next ii
                yData(say, UBound(yData, 2)) = 1
                .Item(krt) = say
            Else
                sira = .Item(krt)
                yData(sira, UBound(yData, 2)) = yData(sira, UBound(yData, 2)) + 1
            End If
        Next i
    End With
    s2.Cells.ClearContents
    s2.Range("A1").Resize(UBound(yData), UBound(yData, 2)).Value = yData
    s2.Cells(1, UBound(yData, 2)) = "Count"
End Sub

 

[Prasad K]

Hi,
Do you want to see such a result?

Sub test()
    Dim s1 As Worksheet, s2 As Worksheet, lR As Long
    Dim data, yData, i&, ii&, krt$, say&, sira&
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    lR = s1.Cells(Rows.Count, 1).End(3).Row
    data = s1.Range("A1:E" & lR).Value
    ReDim yData(1 To UBound(data), 1 To UBound(data, 2) + 1)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(data)
            krt = ""
            For ii = 1 To UBound(data, 2)
                krt = krt & "|" & data(i, ii)
            Next ii

            If Not .exists(krt) Then
                say = say + 1
                For ii = 1 To UBound(data, 2)
                    yData(say, ii) = data(i, ii)
                Next ii
                yData(say, UBound(yData, 2)) = 1
                .Item(krt) = say
            Else
                sira = .Item(krt)
                yData(sira, UBound(yData, 2)) = yData(sira, UBound(yData, 2)) + 1
            End If
        Next i
    End With
    s2.Cells.ClearContents
    s2.Range("A1").Resize(UBound(yData), UBound(yData, 2)).Value = yData
    s2.Cells(1, UBound(yData, 2)) = "Count"
End Sub

Yes This one it's working perfectly & Thankyou so much for your help