patternMinor
Summarizing data from multiple sheets
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:
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
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.
These are good names. Somewhat ambiguous, I'd prefer something like
These are not good names.
If I see something called
Yeah, that was completely non-obvious.
Just call it
Good naming just makes code a hell of a lot easier to work with. Like so:
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
Why does
Why is
Why is
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:
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
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 StringThese 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 LongThese 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 SubNow 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 operatiCode Snippets
Dim service As String
Dim supplier As String
Dim priceRange As String
Dim price As StringDim wsText As Variant
Dim wSum As Worksheet
Dim Lrow As Long
Dim a As Long, b As LongSub 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).TextContext
StackExchange Code Review Q#138840, answer score: 9
Revisions (0)
No revisions yet.