CPSCount

[MCheru]

Here is the code I currently have.

Sub CPSCount()

Columns("B:C").Select
Selection.Copy
Sheets.Add
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "Sheet3"
Range("A1").Select
ActiveSheet.Paste
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown
Range("C1").Select
ActiveCell.FormulaR1C1 = "MP11"
Range("D1").Select
ActiveCell.FormulaR1C1 = "MP12"
Range("E1").Select
ActiveCell.FormulaR1C1 = "MP20"

This is what my code currently does…

Sheet 1 copy columns B:C

Insert new worksheet (Sheet3)

Paste contents into new worksheet (Sheet3) starting in cell A1

Insert row above Row 1

In cell C1 type MP11, in cell D1 type MP12, and in cell E1 type MP20

These are the additional steps I would like my code to take…

Every cell in Column B has either MP11, MP12, or MP20, while every cell in
Column A has a 7 digit number, so the contents of Column A and Column B
belong together.

I want to keep a tally/count of how many times each seven digit number
appears in MP11, MP12, and MP20. In other words, I want to create a code
that will look at the number in Column A then look for MP11, MP12, or MP20 in
Column B. If Column B says MP11 then increase Column C by 1 in the same row,
if Column B says MP12 then increase Column D by 1 in the same row, if Column
B says MP20 then increase Column E by 1 in the same row. Sometimes the seven
digit number in Column A will be repeated. When that happens I want to
delete the row where the duplicate(s) appear(s) but increase the count in
Column C, D, or E (depending on the contents in Column B) by 1.

 

[Joel]

I considered a number of way of performing this task. You r method of
deleting rows is slow. Excel doesn't like deleting rows. So instead I'm
creating a blnk new sheet and then looking up the ID number in column A. If
I find the ID number already on the new sheet I place increment the count in
columns B - D (I'm using B - D instead of C - E) by one. If the ID doesn't
exist I add a new row and then increment the counter.

The column with MP11, MP12, or MP20 (old column C) doesn't make sense on the
summary sheet. Also your method of adding a sheet will create a new
workbook. Is that what you really wnat?


Sub CPSCount()
Set oldsht = Sheets("Sheet1")
Set newsht = Sheets.Add(after:=Sheets(Sheets.Count))
newsht.name = "Summary"

With newsht
.Range("B1") = "MP11"
.Range("C1") = "MP12"
.Range("D1") = "MP20"
NewRow = 2
End With


With oldsht
OldRow = 1
Do While .Range("B" & OldRow) <> ""
ID = .Range("B" & OldRow)
IDType = .Range("C" & OldRow)

With newsht
Set c = .Columns("A").Find(what:=ID, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
.Range("A" & NewRow) = ID
AddRow = NewRow
NewRow = NewRow + 1
Else
AddRow = c.Row
End If

Select Case IDType
Case "MP11"
.Range("B" & AddRow) = _
.Range("B" & AddRow) + 1
Case "MP12"
.Range("C" & AddRow) = _
.Range("C" & AddRow) + 1
Case "MP20"
.Range("D" & AddRow) = _
.Range("D" & AddRow) + 1
End Select
End With

OldRow = OldRow + 1
Loop

End With
End Sub

 

[MCheru]

This is very good. It was what I wanted until I saw you're way. I think
you're way works much better. Thank you.