Summarize raw data in new sheet

Question

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:

enter image description here

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

enter image description here

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" & 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" & r, "A" & r)
 cellstr = cellA.Value
 If InStr(cellstr, str) > 0 Then
 Set cellB = Range("B" & r, "B" & 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

• Kaz: Do you have any power to restructure the raw data? Because that structure desperately needs improving. For more on useful excel data-structures, Joel Spolsky did an excellent introductory tutorial
• Stewie Griffin: I'll check out the link, but first to answer your question: The data above is just a made up format. I chose the format deliberately: Unsorted elements, Variable number of elements in each block, and a header row. I do in fact use a program that outputs data similar to this, only messier. The program is closed, with no API or anything, so I can't alter the formatting of that one.

Answer 1

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