Removing duplicates with a difference

[gibbo1715]

Hi Folks

Been a while since i ve been on the forum and good to see it is still going strong

Ok my question

I have a sheet (eg attached) where there are a number of duplicate records being recovered froma database by way of sql,

Tere will never be more than about 200 or so records being looked at at any one time.

I have the code to remove the duplicate rows easy enough but I have an additional problem as follows

One of the rows is called actions and it contains an action number, each time an action no is created i get a new row from the database (hence the need to remove duplicates), but what i need to do is go through the duplicates, read the action number and end up with one row with each action number on a different column (There will never be more than about 15 I am interested in) Also to complicate it a bit there will be some action numbers i am not interested in, so for example if the action no is 7 it can just be deleted.

Can anyone assist please, I will be very greatful for your assistance on this one

Thanks

Gibbo

My Remove duplicates code

Public Sub DeleteDuplicateRows()
     
    Dim R As Long
    Dim N As Long
    Dim V As Variant
    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
    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
         '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
         ' 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
                Rng.Rows(R).EntireRow.Delete
                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)
     
End Sub

[gibbo1715]

Folks

I ve made some progress i think but stuck on how to put it all on the same row

Heres the code i have now, i ve highlighted the bit i think needs to select the first row called this bit

Thanks for your help

Gibbo

[vba] 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

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).Row
'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(A).Rows(0).Cells(, 4).Value = "Yes"
Case 3
Rng(A).Rows(0).Cells(, 5).Value = "Yes"
Case 4
Rng(A).Rows(0).Cells(, 6).Value = "Yes"
Case 5
Rng(A).Rows(0).Cells(, 7).Value = "Yes"
Case 6
Rng(A).Rows(0).Cells(, 8).Value = "Yes"
Case 7
Rng(A).Rows(0).Cells(, 9).Value = "Yes"
Case 8
Rng(A).Rows(0).Cells(, 10).Value = "Yes"
Case 9
Rng(A).Rows(0).Cells(, 11).Value = "Yes"
Case 10
Rng(A).Rows(0).Cells(, 12).Value = "Yes"
Case 11
Rng(A).Rows(0).Cells(, 13).Value = "Yes"

End Select

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)[/vba]

[Krishna Kumar]

Hi,

Do you need a macro for this ?

In D2 and copied down,

=AND(COUNTIF($C$2:C2,C2)=1,C2<>7)

Filter Column D, select FALSE and delete all rows.

HTH