Summarize raw data in new sheet Note: This question has a follow up question here.

I have an Excel workbook with two sheets: "Raw data" and "Summary". In the raw data sheet there are several blocks with data structured like the image below:



I want to create a summary of the data below, in the sheet "Summary", looking like this:



The way I've done this is:

Sub TransferAndSumElements()
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Set wb = ActiveWorkbook
    Set ws1 = Sheets("Raw data")
    Set ws2 = Sheets("Summary")

    '##############
    ' Copy / Paste first row
    '##############
    ws1.Select
    Rows("1:1").Activate
    Selection.Copy
    ws2.Select
    Range("A1").Select
    ws2.Paste

    '##############
    ' Set Item names in summary
    '##############

    ws2.Select
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Knife"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Fork"
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "Spoon"
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "Spork"
    Range("A6").Select
    ActiveCell.FormulaR1C1 = "Bowl"
    Range("A7").Select

    '##############
    ' Find Elements and Sum
    '##############

    Dim s As Long           ' Sum of elements for each Item
    Dim str As String       ' String in first column in "Summary" (Knife, Fork ...)
    Dim cellstr As String   ' String in first column in "Raw data" (To be searched through)
    Dim DataRange As Range  ' All rows in sheet 1 ("Raw data")

    Dim cellA As Range      ' Used to find cellstr = cellA.Value
    Dim cellB As Range     ' Used to increment s = s + cellB.Value

    ws1.Select              ' Select first worksheet ("This worksheet")
    LastRow = ws1.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    Set DataRange = Range("A1:A" &amp; LastRow)

    For i = 1 To 5          ' Iterate through Knife, Fork .. in "Summary"...

        str = ws2.Cells(i + 1, 1).Value     ' Extract names
        s = 0                               ' Initialize sum
        ws1.Activate                        ' Activate Worksheet 1 ("Raw data")

        For r = 1 To LastRow
            Set cellA = Range("A" &amp; r, "A" &amp; r)
            cellstr = cellA.Value
            If InStr(cellstr, str) &gt; 0 Then
                Set cellB = Range("B" &amp; r, "B" &amp; r)
                s = s + cellB.Value
            End If
        Next r

        ws2.Cells(i + 1, 2).FormulaR1C1 = s

    Next i

ws2.Activate

End Sub


Some stuff that I want to improve, but haven't been able to:


Automatically fetch the item names from "Raw data". I've tried creating a Collection, but I end up with an empty row in between the others (Knife, Fork, Spoon, Spork, Blank, Bowl). 


I can loop through this list after creating it, and delete the blank row, but I think there should be a way to do this in one go.

I want to create a list of words ("Knife", "Fork" .. ) and write it to Excel in one command. The way I'm doing it now is to manually write each item name.
Do the loops make sense, or should I do it in some other way? 


And last but not least:


What about the big picture? Does it make sense to do it like this, or should I do it completely different?


Note: The summary can be sorted alphabetically, by number of elements, or not sorted at all. That doesn't matter.



Tab delimited data dump:

Item    Number
Knife   2
Fork    2
Spoon   1
Spork   2

Item    Number
Spork   2
Fork    3

Item    Number
Bowl    3
Knife   5
You should never, ever, be using Select or Active... in your code.

Unless you explicitly want your sub to click on a cell, or you explicitly want to work off of a user-selection, this is an incredibly slow, inefficient,  fragile way of doing things.

This:

Range("A1").Select
Selection.FormulaR1C1 = "Knife"


Or

Range("A1").Select
ActiveCell.FormulaR1C1 = "Knife"


Is much better expressed like so:

Range("A1").FormulaR1C1 = "Knife"




Furthermore, Range("A1") is implicitly calling [ActiveSheet].Range("A1"). You should explicitly qualify your references to avoid bugs down the road. Like so:

ws2.Range("A1").FormulaR1C1 = "Knife"
ws2.Range("A2").FormulaR1C1 = "Fork"
ws2.Range("A3").FormulaR1C1 = "Spoon"


And then you can use a With statement to make it even better:

With ws2
    .Range("A1").FormulaR1C1 = "Knife"
    .Range("A2").FormulaR1C1 = "Fork"
    .Range("A3").FormulaR1C1 = "Spoon"
End With