You could use a pivot table and manual put it in with the worksheet
menu. Here is equivalent code. Modify the 1st three line as required
to change the sheet names and the start row.



Sub CountItems()

'change 3 lines as required
Set Sourcesht = Sheets("Sheet1")
Set Destsht = Sheets("Sheet2")
StartRow = 1


NewCol = 2
NewRow = 2
RowCount = StartRow
With Sourcesht
Do While .Range("B" & RowCount) < ""
Location = .Range("B" & RowCount)
Item = .Range("C" & RowCount)

With Destsht
'find location in column A
Set c = .Columns("A").Find(what:=Location, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
InsertRow = NewRow
.Range("A" & InsertRow) = Location
NewRow = NewRow + 1
Else
InsertRow = c.Row
End If

'Find Items in Row 1
Set c = .Rows("1").Find(what:=Item, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
InsertCol = NewCol
.Cells(1, InsertCol) = Item
NewCol = NewCol + 1
Else
InsertCol = c.Column
End If

'add data to table
.Cells(InsertRow, InsertCol) = _
.Cells(InsertRow, InsertCol) + 1
End With

RowCount = RowCount + 1
Loop
End With

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=164964

Microsoft Office Help