Hi All

New here so thanks in advance for any help you can offer me

I have a list ( no more than 500 entries that contains duplicates, one of the columns (c) contains an action number ( 1 to 11)

I download this data from a database (Which I cant change) so i will have one persons name (Column A) which will be repeated several times with a cation number in column c as one person can have several actions

e.g.

Name called action
Fred 10.00 1
Fred 10.01 2
Fred 10.01 3
Fred 10.01 4
Fred 10.01 7
John 10.00 5
John 10.01 4
John 10.01 11
Mike 11.00 8
Adam 12.02 2
Adam 12.02 1
Adam 12.02 3
Adam 12.02 4
Adam 12.04 5

What i need to do is delete the duplicates but put a yes in columns d through to M on a single row where they have had an action matching 2 - 11

I have got how to remove duplicates, and i ve managed to do a case statement to put a yes in the row in the right place prior to deleting it

Are you able to help me to get all the data i want onto one line

I ve pasted my existing code below

I really am greatfull for any help you can offer in this regard

Gibbo

Dim R As Long
    Dim N As Long
    Dim V As Variant
    Dim A As Long
    Dim rng As Range
     
    'On Error GoTo EndMacro
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
     
     
    Set rng = Application.Intersect(ActiveSheet.UsedRange, _
    ActiveSheet.Columns(ActiveCell.Column))
     
    Application.StatusBar = "Processing Row: " & Format(rng.Row, "#,##0")
     
    N = 0
    'A = Rng.Rows(1).Row
    For R = rng.Rows.Count To 2 Step -1
        If R Mod 500 = 0 Then
            Application.StatusBar = "Processing Row: " & Format(R, "#,##0")
        End If

        V = rng.Cells(R, 1).Value
        
        
        'This Bit*************************
        'A = Rng(R).Rows.Row(2)
        'MsgBox A
        'This Bit*************************
        
        
         '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
         ' Note that COUNTIF works oddly with a Variant that is equal to vbNullString.
         ' Rather than pass in the variant, you need to pass in vbNullString explicitly.
         '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        If V = vbNullString Then
            If Application.WorksheetFunction.CountIf(rng.Columns(1), vbNullString) > 1 Then

                rng.Rows(R).EntireRow.Delete

                N = N + 1
            End If
        Else
        
        
            If Application.WorksheetFunction.CountIf(rng.Columns(1), V) > 1 Then
            
            
            'Case Statement
            
            Select Case rng.Cells(R, 3).Value
            
            Case 2
            rng(R).Rows(1).Cells(, 4).Value = "Yes"
            Case 3
            rng(R).Rows(1).Cells(, 5).Value = "Yes"
            Case 4
            rng(R).Rows(1).Cells(, 6).Value = "Yes"
            Case 5
            rng(R).Rows(1).Cells(, 7).Value = "Yes"
            Case 6
            rng(R).Rows(1).Cells(, 8).Value = "Yes"
            Case 7
            rng(R).Rows(1).Cells(, 9).Value = "Yes"
            Case 8
            rng(R).Rows(1).Cells(, 10).Value = "Yes"
            Case 9
            rng(R).Rows(1).Cells(, 11).Value = "Yes"
            Case 10
            rng(R).Rows(1).Cells(, 12).Value = "Yes"
            Case 11
            rng(R).Rows(1).Cells(, 13).Value = "Yes"
            
            End Select
            'rng.Offset(, 1) =
            
                N = N + 1
                
            End If
            
        End If
    Next R
     
EndMacro:
     
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Duplicate Rows Deleted: " & CStr(N)