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 & 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 iws2.ActivateEnd SubSome 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    NumberKnife   2Fork    2Spoon   1Spork   2Item    NumberSpork   2Fork    3Item    NumberBowl    3Knife   5
Summarize raw data in new sheet
beginner;vba;excel
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).SelectSelection.FormulaR1C1 = KnifeOrRange(A1).SelectActiveCell.FormulaR1C1 = KnifeIs much better expressed like so:Range(A1).FormulaR1C1 = KnifeFurthermore, 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 = Knifews2.Range(A2).FormulaR1C1 = Forkws2.Range(A3).FormulaR1C1 = SpoonAnd 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 = SpoonEnd With