PDA

View Full Version : Removing duplicates with a difference



gibbo1715
11-07-2009, 02:55 AM
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
11-07-2009, 05:56 AM
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

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)

Krishna Kumar
11-08-2009, 08:33 AM
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