Anonymous
Anonymous

Reputation: 29

Excel Vba to copy duplicate values and paste it another sheets

I am using Excel macros to sort my data wherein if any same data occurs it should be copied into a new sheet. For multiple type of data multiple sheets will be used. For example, if I have the following data:

col1 col2 col3 
101  cs     abc 
102  ds     cdf 
101  cs     abc 
102  ds     cdf 
102  ds     cdf 
103  cs     efg
104  cs     jsj

And I want only data where col2 = "cs" so if 101 and cs arrives for the first time then it should not be counted. If count is more than one then the entire row should be copied and pasted to a new sheet. Same process should be done for the rest arrivals...i.e. 103, 104 etc and so on.....Macros which i used is..

Private Sub Workbook_Open() 
    Dim i 
    Dim LastRow As Long 
    LastRow = Sheets("Sample1").Range("A" & Rows.Count).End(xlUp).Row 
    Sheets("Sheet1").Range("A2:I500").ClearContents 
    For i = 2 To LastRow 
        If Sheets("Sample1").Cells(i, "E").Value = "Customer" Then 
            Count = Count + 1 
            If Count > 1 Then 
                Sheets("Sample1").Cells(i, "E").EntireRow.Copy Destination:=Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1) 
            End If 
        End If 
    Next i 
End Sub 

Upvotes: 0

Views: 3796

Answers (1)

Chris Harper
Chris Harper

Reputation: 213

You should count the number of occurance of the value from the beginning of rows until the loop value -i- :

Dim i
Dim LastRow As Long
LastRow = Sheets("Sample1").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet1").Range("A2:I500").ClearContents
For i = 2 To LastRow
    If Sheets("Sample1").Cells(i, "E").Value = "Customer" Then
  Count = Application.WorksheetFunction.CountIf(Range("B1:B" & i), Sheets("Sample1").Cells(i, "B"))
        If Count > 1 Then
            Sheets("Sample1").Cells(i, "E").EntireRow.Copy Destination:=Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If
    End If
Next i

Upvotes: 1

Related Questions