2
\$\begingroup\$

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
\$\endgroup\$
  • \$\begingroup\$ 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 \$\endgroup\$ – Kaz Jun 16 '16 at 12:01
  • \$\begingroup\$ 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. \$\endgroup\$ – Stewie Griffin Jun 16 '16 at 12:08
1
\$\begingroup\$

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
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.