complex sort search and replace macro

[Colin Hayes]

Hi All

I have many rows where there are pairs of certain cells duplicated. I'm
trying to count all rows with the same duplicate entries and put the
total in a separate column. After this the other rows which satisfied
the criteria would be deleted.

So , Count all rows where O1 and M1 are identical . Add the numbers in
L1 and place total in L1. Delete all rows except the first. This should
give a single row which gives a summary total for rows with identical
values in the named cells. Leave unidentical rows unaffected.

Run check through the whole worksheet until complete.

EG

Before :

L O M

2 2567 AA
1 2567 AB
3 2567 AA
1 2567 AA
2 9874 LP
4 6678 CV
2 8887 AB
3 6678 CV
1 8887 AB


After :

L O M

6 2567 AA
1 2567 AB
2 9874 LP
7 6678 CV
3 8887 AB



Grateful for any assistance.



Best Wishes

 

[Claus Busch]

Hi Colin,

Am Sun, 13 Jan 2013 20:36:55 +0000 schrieb Colin Hayes:

I have many rows where there are pairs of certain cells duplicated. I'm
trying to count all rows with the same duplicate entries and put the
total in a separate column. After this the other rows which satisfied
the criteria would be deleted.

So , Count all rows where O1 and M1 are identical . Add the numbers in
L1 and place total in L1. Delete all rows except the first. This should
give a single row which gives a summary total for rows with identical
values in the named cells. Leave unidentical rows unaffected.

Run check through the whole worksheet until complete.

your values in sheet1 and the sum of values in sheet2:

Sub Test()
Dim LRow As Long

With Sheets("Sheet1")
.Range("M1:N1").Copy Sheets("Sheet2").Range("B1")
LRow = .Cells(.Rows.Count, "M").End(xlUp).Row
.Range("M1:N" & LRow).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Sheet2").Range("B1:C1"), Unique:=True
End With

With Sheets("Sheet2")
.Range("A2").Formula = "=Sumproduct(--(Sheet1!$M$2:$M$" & LRow & _
"=B2),--(Sheet1!$N$2:$N$" & LRow & "=C2),Sheet1!$L$2:$L$" & LRow &
")"
LRow = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range("A2").AutoFill Destination:=.Range("A2:A" & LRow)
End With

End Sub

Regards
Claus Busch

 

[Claus Busch]

Hi Colin,

Am Sun, 13 Jan 2013 22:26:20 +0100 schrieb Claus Busch:

your values in sheet1 and the sum of values in sheet2:

important: your columns must have headers


Regards
Claus Busch