Any idea how to modify this macro to copy only unique data into all worksheets?

[Lehoi]

Hi

I am using this macro to extract data from Master Sheet "Daily Data" to other worksheets:

Sub SplitData()

    Const NameCol = "E"
    Const HeaderRow = 1
    Const FirstRow = 2
    Dim SrcSheet As Worksheet
    Dim TrgSheet As Worksheet
    Dim SrcRow As Long
    Dim lastRow As Long
    Dim TrgRow As Long
    Dim Team As String
    Application.ScreenUpdating = False

    Set SrcSheet = ActiveWorkbook.Worksheets("Daily Data")
    lastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
    For SrcRow = FirstRow To lastRow
        Team = SrcSheet.Cells(SrcRow, NameCol).Value
        Set TrgSheet = Nothing
        On Error Resume Next
        Set TrgSheet = Worksheets(Team)
        On Error GoTo 0
        If TrgSheet Is Nothing Then
            Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            TrgSheet.name = Team
            SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)
        End If
        TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
        SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
    Next SrcRow
    Application.ScreenUpdating = True
End Sub

What I am looking for is to add only new data into worksheets to prevent duplicate data.

Besides that, how can I prevent the creation of new worksheets if doesn't exist?
I only need add new data to existing worksheets, if column E has values without coincident worksheets, ignore them.

Any help would be appreciated
Regards
Lehoi

 

[JLGWhiz]

After thinking about the CountIf statement for a while, and looking at the type of data you are working with, I thought that the only way to ID a true duplicate would be to match the corresponding date and time along with the name, since the name could very well be listed more than once for different dates. If this assumption is true, then maybe the code below would be a better bet than the first one I posted.

Sub SplitData()
    Const NameCol = "E"
    Const HeaderRow = 1
    Const FirstRow = 2
    Dim SrcSheet As Worksheet
    Dim TrgSheet As Worksheet
    Dim SrcRow As Long
    Dim lastRow As Long
    Dim TrgRow As Long
    Dim Team As String
    Application.ScreenUpdating = False
    Set SrcSheet = ActiveWorkbook.Worksheets("Daily Data")
    lastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
    For SrcRow = FirstRow To lastRow
        Team = SrcSheet.Cells(SrcRow, NameCol).Value
        Set TrgSheet = Nothing
        On Error Resume Next
        Set TrgSheet = Worksheets(Team)
        If Err.Number = 9 Then Exit Sub
        On Error GoTo 0
        TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
        If Application.CountIf(TrgSheet.Range("E:E"), SrcSheet.Cells(SrcRow, "E").Value) > 0 [COLOR="#B22222"]And _
        TrgSheet.Range("E:E").Find(SrcSheet.Cells(SrcRow, "E").Value, , xlValues).Offset(, -1).Value = SrcSheet.Cells(SrcRow, "D").Value [/COLOR]Then
            MsgBox "Duplicate Detected for " & SrcSheet.Cells(SrcRow, "E").Value
        Else
            SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
        End If
    Next SrcRow
    Application.ScreenUpdating = True
End Sub