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\$
2
  • \$\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\$ Commented Jun 16, 2016 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\$ Commented Jun 16, 2016 at 12:08

1 Answer 1

Reset to default
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\$
0

You must log in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.