Creating a unique list of Cost Codes in Col. A from all worksheets in all workbooks in folder X



How do I create in a new Workbook, a unique list of Cost Codes in Col.
A from all worksheets in all workbooks in folder X. , in a grid
format to be able to detect less used codes as follows:

Code WBA-Sh1 WBA-Sh2 WBB-Sh1 WBB-Sh2 WBB-Sh3 Total
X 1 1
1 3
Y 1 1
1 1 4
Z 1
1 2
WBB-Sh3 = Workbook B Sheet 3
Thank you again for the help to all the Gurus.




The code below should work

Put the codes you want to look up in the new workbook in column A starting
in row 2. The macro also will go in the new workbook. Change Mypath to the
appropriate path. the code will automatically put the workbook name and
worksheet in the first row for each sheet it counts. The code uses the
worksheet function Countif to get the totals.

Sub addcostcodes()

Const MyPath = "c:\temp"

With ThisWorkbook.Sheets("sheet1")
Sh1Lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
ColumnCount = 2
First = True
If First = True Then
Filename = Dir(MyPath & "\*.xls")
First = False
Filename = Dir()
End If
If Filename <> "" Then

Workbooks.Open MyPath & "\" & Filename
For Each ws In ActiveWorkbook.Worksheets
.Cells(1, ColumnCount) = _
ActiveWorkbook.Name & " - " & _
Lastrow = ws.Cells(Rows.Count, "A"). _
Set SearchRange = Range("A2:A" & Lastrow)

For Sh1rowCount = 2 To Sh1Lastrow
costcode = .Range("A" & Sh1rowCount).Value
Count = WorksheetFunction.CountIf(SearchRange, costcode)
.Cells(Sh1rowCount, ColumnCount) = Count
Next Sh1rowCount
ColumnCount = ColumnCount + 1
Next ws
End If
Loop While Filename <> ""
End With
End Sub

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question