# Find duplicates, sum column then delete duplicates

aileen
Guest
Posts: n/a

 9th Dec 2008

I need to decipher if a row is a duplicate based on matching data in cells I,
K, L, N, and F. If the row is a duplicate, I need to add the value in cell F
to the original row's value in cell F and then delete the duplicate row. The
# of rows in the workbook changes everyday and the duplicates will not always
be right below the row it is duplicating.

Is this possible? Thanks for any help.

aileen
Guest
Posts: n/a

 9th Dec 2008

To clarify, there may be more than one duplicate row and they will always be
directly below the original row they are duplicating.

"aileen" wrote:

> I need to decipher if a row is a duplicate based on matching data in cells I,
> K, L, N, and F. If the row is a duplicate, I need to add the value in cell F
> to the original row's value in cell F and then delete the duplicate row. The
> # of rows in the workbook changes everyday and the duplicates will not always
> be right below the row it is duplicating.
>
> Is this possible? Thanks for any help.
>

ryguy7272
Guest
Posts: n/a

 11th Dec 2008
Step #1) Make a copy of your file so you are not deleting records that you
don't intend to delete (you may not know what a macro does until you run it;
it may do something that you don't expect it to do...)

Step #2) Run one of these two macros (below):

Sub CheckForDupes()

Dim RowNdx As Long
Dim ColNum As Integer
ColNum = Selection(1).Column 'set number to match the proper column
For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1
If Cells(RowNdx, ColNum).Value = Cells(RowNdx - 1, ColNum).Value Then
Cells(RowNdx, ColNum).Delete Shift:=xlUp
End If
Next RowNdx
End Sub

Sub DeleteDuplicateRows()
Dim lLastRow As Long
Dim lLastCol As Long
Dim i As Long
Dim j As Long
Dim k As Long
lLastRow = ActiveSheet.UsedRange.Rows.Count - 1
lLastCol = ActiveSheet.UsedRange.Columns.Count - 1
For i = 0 To lLastRow - 1
For j = lLastRow To i + 1 Step -1
For k = 0 To lLastCol
If ActiveSheet.Range("A1").Offset(i, k).Value <>
ActiveSheet.Range("A1").Offset(j, k).Value Then
Exit For
End If
Next k
If k > lLastCol Then
ActiveSheet.Range("A1").Offset(j, 0).EntireRow.Delete
End If
Next j
Next i
End Sub

Regards,
Ryan---
--
RyGuy

"aileen" wrote:

> To clarify, there may be more than one duplicate row and they will always be
> directly below the original row they are duplicating.
>
> "aileen" wrote:
>
> > I need to decipher if a row is a duplicate based on matching data in cells I,
> > K, L, N, and F. If the row is a duplicate, I need to add the value in cell F
> > to the original row's value in cell F and then delete the duplicate row. The
> > # of rows in the workbook changes everyday and the duplicates will not always
> > be right below the row it is duplicating.
> >
> > Is this possible? Thanks for any help.
> >

aileen
Guest
Posts: n/a

 11th Dec 2008
This isn't working quite the way I need. Here is an example of what I am
trying to accomplish:
The following is an example of the set of data I'm starting with:
Column C D E F G H
5 1 2 3 4
10 1 2 3 4
15 1 2 3 4
20 1 2 3 4
-6 2 3 4 5
-3 3 4 5 6
-4 3 4 5 6
25 1 2 5 7
And the following is what I want the data to do when I run the macro. Sum
Column C and put the total in H when there are duplicates and then delete the
extra rows of duplicates only.
Column C D E F G H
5 1 2 3 4 50
-6 2 3 4 5
-3 3 4 5 6 -7
25 1 2 5 7
I hope this helps you to better see what I am attempting to do. Thanks for
responding and please let me know if you have any more ideas.

"ryguy7272" wrote:

> Step #1) Make a copy of your file so you are not deleting records that you
> don't intend to delete (you may not know what a macro does until you run it;
> it may do something that you don't expect it to do...)
>
> Step #2) Run one of these two macros (below):
>
> Sub CheckForDupes()
>
> Dim RowNdx As Long
> Dim ColNum As Integer
> ColNum = Selection(1).Column 'set number to match the proper column
> For RowNdx = Selection(Selection.Cells.Count).Row To _
> Selection(1).Row + 1 Step -1
> If Cells(RowNdx, ColNum).Value = Cells(RowNdx - 1, ColNum).Value Then
> Cells(RowNdx, ColNum).Delete Shift:=xlUp
> End If
> Next RowNdx
> End Sub
>
> Sub DeleteDuplicateRows()
> Dim lLastRow As Long
> Dim lLastCol As Long
> Dim i As Long
> Dim j As Long
> Dim k As Long
> lLastRow = ActiveSheet.UsedRange.Rows.Count - 1
> lLastCol = ActiveSheet.UsedRange.Columns.Count - 1
> For i = 0 To lLastRow - 1
> For j = lLastRow To i + 1 Step -1
> For k = 0 To lLastCol
> If ActiveSheet.Range("A1").Offset(i, k).Value <>
> ActiveSheet.Range("A1").Offset(j, k).Value Then
> Exit For
> End If
> Next k
> If k > lLastCol Then
> ActiveSheet.Range("A1").Offset(j, 0).EntireRow.Delete
> End If
> Next j
> Next i
> End Sub
>
> Regards,
> Ryan---
> --
> RyGuy
>
>
> "aileen" wrote:
>
> > To clarify, there may be more than one duplicate row and they will always be
> > directly below the original row they are duplicating.
> >
> > "aileen" wrote:
> >
> > > I need to decipher if a row is a duplicate based on matching data in cells I,
> > > K, L, N, and F. If the row is a duplicate, I need to add the value in cell F
> > > to the original row's value in cell F and then delete the duplicate row. The
> > > # of rows in the workbook changes everyday and the duplicates will not always
> > > be right below the row it is duplicating.
> > >
> > > Is this possible? Thanks for any help.
> > >

 Thread Tools Rate This Thread Rate This Thread: 5 : Excellent 4 : Good 3 : Average 2 : Bad 1 : Terrible

 Posting Rules You may not post new threads You may not post replies You may not post attachments You may not edit your posts BB code is On Smilies are On [IMG] code is On HTML code is OffTrackbacks are On Pingbacks are On Refbacks are Off Forum Rules

 Similar Threads Thread Thread Starter Forum Replies Last Post Boss Microsoft Access VBA Modules 4 23rd May 2009 04:06 PM Boss Microsoft Access 1 22nd May 2009 04:25 PM Boss Microsoft Access VBA Modules 0 22nd May 2009 03:54 PM Boss Microsoft Access VBA Modules 0 22nd May 2009 03:54 PM aileen Microsoft Excel Programming 7 11th Dec 2008 04:15 PM

Features