HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Summarizing data from multiple sheets

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
sheetssummarizingmultiplefromdata

Problem

I have 9 sheets with 1668 rows and 34 cols. The code collects all data from every sheet into one Summary sheet in the following format:

service 1 supplier 1 price etc..
service 1 supplier 2 price etc..


Unfortunately excel freezes around the 7k row and I receive 'out of memory' error. Any suggestions how to solve improve to code to run on large data?

```
Sub goEasy()

Dim wsText As Variant
Dim sht As Worksheet
Dim wSum As Worksheet
Dim service As String
Dim supplier As String
Dim priceRange As String
Dim price As String
Dim Lrow As Long, LastRow As Long
Dim a As Long, b As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Set sht = ThisWorkbook.Worksheets(4)
Set wSum = ThisWorkbook.Worksheets("Summary")

wsText = Array("<25K", "25K <100K", "100K <250K", "250K <500K", "500K <1M", "1M <5M", "5M <15M", "15M <30M", "30M <50M")

LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

For Each element In wsText
'For i = 5 To LastRow
a = 4
b = 12
Do While a < LastRow
'For j = 13 To 47

If a = LastRow Then
a = 4
Exit Do
End If
a = a + 1

Do While b <= 47

If b = 47 Then
b = 12
Exit Do
End If

b = b + 1
Lrow = wSum.UsedRange.Rows(wSum.UsedRange.Rows.Count).Row + 1

service = ThisWorkbook.Worksheets(element).Cells(a, 1).Text
supplier = ThisWorkbook.Worksheets(element).Cells(4, b).Text
priceRange = ThisWorkbook.Worksheets(element).Cells(2, 1).Text
price = ThisWorkbook.Worksheets(element).Cells(a, b).Text

wSum.Cells(Lrow, 1) = service
wSum.Cells(Lrow, 2) = supplier
wSum.Cells(Lrow, 3) = priceRange
wSum.Cells(Lrow, 4) = price
'Next j
Loop
'Next

Solution

Naming

In order for code to be useful, it has to be understood. This applies equally to you now, you in 6 months and anybody else who eventually has to work with it. As such, code should be written for other people to read and understand.

Documentation helps with this. Writing down what your program is doing/why. But the easiest way is just to name things descriptively and unambiguously.

Dim service As String
Dim supplier As String
Dim priceRange As String
Dim price As String


These are good names. Somewhat ambiguous, I'd prefer something like serviceName, supplierName, priceText etc. to be completely unambiguous, but I can look anywhere in your code, see those variables and know precisely what they are.

Dim wsText As Variant
Dim wSum As Worksheet
Dim Lrow As Long
Dim a As Long, b As Long


These are not good names.

If I see something called wsText I'm going to parse that as Worksheet Text which means... some kind of text, in a worksheet? A worksheet called text? Oh, it's a list of worksheet names.

Yeah, that was completely non-obvious.
Just call it worksheetNames or maybe targetWorksheetNames.

wSum is similarly ambiguous and not-obvious about what it is. Just call it summarySheet.

a, b are generic, and hence useless. Here, they refer to Row and Column indexes, so why not call them currentRow, currentcolumn?

Good naming just makes code a hell of a lot easier to work with. Like so:

Sub AggregateSheetData()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Dim sheetNames As Variant
    sheetNames = Array("<25K", "25K <100K", "100K <250K", "250K <500K", "500K <1M", "1M <5M", "5M <15M", "15M <30M", "30M <50M")

    Dim summarySheet As Worksheet
    Set summarySheet = ThisWorkbook.Worksheets("Summary")

    Dim currentSummaryRow As Long
    currentSummaryRow = summarySheet.Cells(summarySheet.Cells.Count, 1).End(xlUp).Row

    Dim service As String
    Dim supplier As String
    Dim priceRange As String
    Dim price As String

    Dim currentSheet As Worksheet
    Dim currentSheetName As String
    Dim currentRow As Long, currentColumn As Long
    Dim lastRow As Long

    Dim sheetCounter As Long
    For sheetCounter = LBound(sheetNames) To UBound(sheetNames)

        currentSheetName = sheetNames(sheetCounter)
        Set currentSheet = ThisWorkbook.Worksheets(currentSheetName)

        lastRow = currentSheet.Cells(currentSheet.Rows.Count, 1).End(xlUp).Row

        For currentRow = 5 To lastRow
            currentSummaryRow = currentSummaryRow + 1

            For currentColumn = 12 To 47

                priceRange = currentSheet.Cells(2, 1).Text
                service = currentSheet.Cells(currentRow, 1).Text
                supplier = currentSheet.Cells(4, currentColumn).Text
                price = currentSheet.Cells(currentRow, currentColumn).Text

                summarySheet.Cells(currentSummaryRow, 1) = service
                summarySheet.Cells(currentSummaryRow, 2) = supplier
                summarySheet.Cells(currentSummaryRow, 3) = priceRange
                summarySheet.Cells(currentSummaryRow, 4) = price

            Next currentColumn
        Next currentRow
    Next sheetCounter

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

    MsgBox ("Complete")

End Sub


Now things are becoming a lot clearer, and we can move on to the next stage of making this code useful. Namely, explaining and documenting important information.

Magic Numbers

A magic number is any hard-coded value which appears in your code.

Why does a start at 5?

Why does b only go from 12 to 47?

Why is supplier always pulled from row 5?

Why is service always pulled from column 1?

Why are they laid out in columns 1-4 of the summary sheet, and in that order?

How do we know that our worksheets haven't been renamed?

For each of these questions, you should either re-structure your code so they don't have to be hard-coded, or you leave a note explaining why they have the values they have and put them in appropriate variables.

In this case, I recommend constants. Like so:

'/ Each sheet is laid out with Suppliers on row 4, Service in column 1, and then price values in a grid.
Const SUPPLIER_ROW As Long = 4
Const SERVICE_COLUMN As Long = 1

...

...

For currentRow = SUPPLIER_ROW + 1 to finalRow
    For currentColumn = SERVICE_COLUMN + 1 to finalColumn

    ...

    ...


And now, if your data ever moves around, you only have to go and change that value in one place. And everywhere else in your code, you can refer to your constant by name, rather than trusting that you'll remember why the numbers are what they are.

Arrays

This is where we're going to give you a serious performance tune-up. I expect it will solve all of your speed and memory problems.

Doing anything to a Worksheet is a huge operati

Code Snippets

Dim service As String
Dim supplier As String
Dim priceRange As String
Dim price As String
Dim wsText As Variant
Dim wSum As Worksheet
Dim Lrow As Long
Dim a As Long, b As Long
Sub AggregateSheetData()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Dim sheetNames As Variant
    sheetNames = Array("<25K", "25K <100K", "100K <250K", "250K <500K", "500K <1M", "1M <5M", "5M <15M", "15M <30M", "30M <50M")

    Dim summarySheet As Worksheet
    Set summarySheet = ThisWorkbook.Worksheets("Summary")

    Dim currentSummaryRow As Long
    currentSummaryRow = summarySheet.Cells(summarySheet.Cells.Count, 1).End(xlUp).Row

    Dim service As String
    Dim supplier As String
    Dim priceRange As String
    Dim price As String

    Dim currentSheet As Worksheet
    Dim currentSheetName As String
    Dim currentRow As Long, currentColumn As Long
    Dim lastRow As Long

    Dim sheetCounter As Long
    For sheetCounter = LBound(sheetNames) To UBound(sheetNames)

        currentSheetName = sheetNames(sheetCounter)
        Set currentSheet = ThisWorkbook.Worksheets(currentSheetName)

        lastRow = currentSheet.Cells(currentSheet.Rows.Count, 1).End(xlUp).Row

        For currentRow = 5 To lastRow
            currentSummaryRow = currentSummaryRow + 1

            For currentColumn = 12 To 47

                priceRange = currentSheet.Cells(2, 1).Text
                service = currentSheet.Cells(currentRow, 1).Text
                supplier = currentSheet.Cells(4, currentColumn).Text
                price = currentSheet.Cells(currentRow, currentColumn).Text

                summarySheet.Cells(currentSummaryRow, 1) = service
                summarySheet.Cells(currentSummaryRow, 2) = supplier
                summarySheet.Cells(currentSummaryRow, 3) = priceRange
                summarySheet.Cells(currentSummaryRow, 4) = price

            Next currentColumn
        Next currentRow
    Next sheetCounter

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

    MsgBox ("Complete")

End Sub
'/ Each sheet is laid out with Suppliers on row 4, Service in column 1, and then price values in a grid.
Const SUPPLIER_ROW As Long = 4
Const SERVICE_COLUMN As Long = 1

...

...

For currentRow = SUPPLIER_ROW + 1 to finalRow
    For currentColumn = SERVICE_COLUMN + 1 to finalColumn

    ...

    ...
priceRange = currentSheet.Cells(2, 1).Text

Context

StackExchange Code Review Q#138840, answer score: 9

Revisions (0)

No revisions yet.