# word count

#### leebre

##### New Member
I have part numbers for different regions that are the same and want get a grand total. my work book consists of 31 spreadsheets where the part numbers are listed. I would like to get the total number of duplicate part numbers within the entire workbook on one page listed as
partnumber, qty

any one know how I can do this?

### Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

#### Diffy

##### Well-known Member
Hello,

I am afraid you will need to be more specific. It is certainly possible to sum the sheets to get a grand total, but could you post an example of how the data is set up, and provide ranges, criteria for summing etc.

Thanks

#### stanleydgromjr

##### Banned
leebre,

What column are the part numbers in for the 31 worksheets?

What is the name of the summary worksheet?

Have a great day,
Stan

#### leebre

##### New Member
Here is the example:

20 different regions have this part # FC9681CPU209

each region has 20 for easy math

the main page would show:
PART NUMBER QTY
FC9681CPU209 400

I would like one total page that will calculate the total from all pages and display beside the part number so I don't have to go through all 20 sheets and count

#### leebre

##### New Member
all data is in column A and the summary sheet is just called summary

#### stanleydgromjr

##### Banned
leebre,

Press and hold down the 'ALT' key, and press the 'F11' key.

Insert a Module in your VBAProject, Microsoft Excel Objects

Copy the below code, and paste it into the Module1.

Code:
``````Option Explicit
Sub CountDuplicatePartNumbers()
'
' CountDuplicatePartNumbers Macro
' Macro created 08/10/2007 by Stanley D. Grom, Jr.
'
Dim lngWsLastRow As Long
Dim lngSummaryLastRow As Long
Dim Wb As Workbook
Dim Ws As Worksheet

Application.ScreenUpdating = False
Sheets("Summary").Select
Set Wb = ActiveWorkbook
'Column D = all part numbers
'Column E = unique part numbers
With Columns("D:E")
.EntireColumn.Insert
End With
Range("D1:E1") = "Part Number"
For Each Ws In Wb.Worksheets
If Ws.Name <> "Summary" Then
lngSummaryLastRow = Sheets("Summary").Range("D" & Rows.Count).End(xlUp).Row + 1
lngWsLastRow = Sheets(Ws.Name).Range("A" & Rows.Count).End(xlUp).Row
Sheets(Ws.Name).Range("A2:A" & lngWsLastRow).Copy Sheets("Summary").Range("D" & lngSummaryLastRow)
End If
Next Ws
lngSummaryLastRow = Sheets("Summary").Range("D" & Rows.Count).End(xlUp).Row
Range("D1:D" & lngSummaryLastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("E1:E" & lngSummaryLastRow), Unique:=True
lngSummaryLastRow = Sheets("Summary").Range("E" & Rows.Count).End(xlUp).Row
With Range("E2:E" & lngSummaryLastRow)
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
.Copy Range("A2")
Application.CutCopyMode = False
End With
With Range("E1:E" & lngSummaryLastRow)
.ClearContents
End With
lngSummaryLastRow = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Row
lngWsLastRow = Sheets("Summary").Range("D" & Rows.Count).End(xlUp).Row
With Range("B2:B" & lngSummaryLastRow)
.FormulaR1C1 = "=COUNTIF(R2C4:R" & lngWsLastRow & "C4,RC[-1])"
.Copy
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
With Columns("D:E")
.EntireColumn.Delete
End With
Range("C1").Select
Application.ScreenUpdating = True
End Sub``````

Then run the 'CountDuplicatePartNumbers' macro.

Have a great day,
Stan

#### jindon

##### MrExcel MVP
Only count?
Code:
``````Sub test()
Dim ws As Worksheet, a, i As Long, b(), n As Long, x As Long
On Error Resume Next
Sheets("Summary").Delete
ReDim b(1 To Rows.Count, 1 To 3)
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For Each ws In Worksheets
If ws.Name <> "Summary" Then
a = ws.Range("a1").CurrentRegion.Resize(,2).Value
For i = 2 To UBound(a,1)
If Not .exists(a(i,1)) Then
n = n + 1 : b(n,1) = a(i,1)
End If
x = .item(a(i,1))
b(x,2) = b(x,2) + 1 : b(x,3) = b(x,3) + a(i,2)
Next
End If
Next
End With
With Sheets("Summary")
.Range("a1").Resize(,3).Value = [{"Part#","Appearance","Total"}]
.Range("b1").Resize(n,3).Value = b
End With
End Sub``````

#### facethegod

##### Well-known Member
Try this maybe....?

Code:
``````Option Explicit
Public Sub femi()
Dim i, j, Lrow As Double
Dim ar(), ar1(), fo As Variant
Dim cell, c As Range
Dim wk As Worksheet
On Error Resume Next
Application.ScreenUpdating = False
ReDim Preserve ar1(1 To Rows.Count, 1 To 2)
For Each wk In Worksheets
If wk.Name <> "Summary" Then
wk.Activate
Lrow = Cells(Rows.Count, 2).End(xlUp).Row
For Each cell In Range("B2:B" & Lrow)
i = i + cell.Count
ReDim Preserve ar(1 To i)
ar(i) = cell
Set c = Range("A:A").Find(ar(i), LookIn:=xlValues)
If c Is Nothing Then Exit For
c.Select
j = j + 1
Range("A:A").FindNext(After:=ActiveCell).Select
Loop
ar1(i, 1) = ar(i)
ar1(i, 2) = j
Sheets("Summary").Cells(i, 1) = ar(i)
Sheets("Summary").Cells(i, 2) = j
j = 0
Next
Columns("B:B").ClearContents
End If
Next
Sheets("Summary").Activate
Range("1:1").Insert Shift:=xlDown
Range("a1").Resize(1, 2).Value = [{"Part#","Qty"}]
Lrow = Cells(Rows.Count, 3).End(xlUp).Row
Range("D2").Formula = "=Sumif(A:A,C2,B:B)"
Range("D2").Resize(Lrow - 1, 1).FillDown
Columns("D:D").Copy
Columns("D:D").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:B").Delete
Range("a1").Resize(1, 2).Value = [{"Part#","Qty"}]
Application.ScreenUpdating = True
End Sub``````

HTH

Replies
1
Views
144
Replies
2
Views
171
Replies
0
Views
118
Replies
1
Views
289
Replies
3
Views
127

1,191,587
Messages
5,987,507
Members
440,098
Latest member
MickyMouse123

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back