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 operation. If you write
priceRange = currentSheet.Cells(2, 1).Text
it doesn't feel like a big operation, but you have to query the Worksheet Object, which queries the Cells object, which searches through a couple billion range objects to find the one you're after, which then gets queried to determine the text value it's currently displaying. This also triggers Worksheet Events (query handlers, events, calculations, screenUpdating, validation, etc.) which fire off their own chains of cascading events and so on and so forth.
And you're doing this roughly 2 Million times.
(N.B. the above is for illustration only. The actual chain of events is much more complex and convoluted).
When working with data, what you want is an Array. An Array is just a grid of values laid out in memory, so querying a value from an Array is literally a trillion times faster than querying it from a Worksheet object.
VBA makes this incredibly easy. Just create a Range that encompasses all your data, and do the following:
Dim dataArray As Variant
dataArray = dataRange
And now, whatever was in the topLeft Cell of your Range is in dataArray(1, 1). Next row down dataArray(2, 1) and so forth. you can then read this data back to a worksheet by doing the same in reverse:
pasteRange = dataArray
The following is your code, re-written to use Arrays, and it will be quite literally a thousand times faster:
Sub AggregateSheetData()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'/ row/column positions on data sheets
Const SUPPLIER_ROW As Long = 4
Const SERVICE_COLUMN As Long = 1
Const START_COLUMN As Long = 12
Const SUMMARY_SHEET_NAME As String = "Summary"
Dim sheetNames As Variant
sheetNames = Array("<25K", "25K <100K", "100K <250K", "250K <500K", "500K <1M", "1M <5M", "5M <15M", "15M <30M", "30M <50M")
Dim summaryData As Variant
ReDim summaryData(1 To 4, 1 To 1)
Dim summaryCounter As Long
Dim service As String
Dim supplier As String
Dim priceRange As String
Dim price As String
Dim dataRange As Range
Dim sheetData As Variant
Dim finalRow As Long, finalColumn As Long
Dim iRow As Long, iColumn As Long
Dim currentSheet As Worksheet
Dim currentSheetName As String
Dim sheetCounter As Long
For sheetCounter = LBound(sheetNames) To UBound(sheetNames)
currentSheetName = sheetNames(sheetCounter)
Set currentSheet = ThisWorkbook.Worksheets(currentSheetName)
With currentSheet
priceRange = .Cells(2, 1).Text
finalRow = .Cells(.Rows.Count, SERVICE_COLUMN).End(xlUp).Row
finalColumn = .Cells(SUPPLIER_ROW, .Columns.Count).End(xlToLeft).Column
Set dataRange = .Range(.Cells(SUPPLIER_ROW, SERVICE_COLUMN), .Cells(finalRow, finalColumn))
End With
sheetData = dataRange
Dim LB1 As Long, UB1 As Long
Dim LB2 As Long, UB2 As Long
LB1 = LBound(sheetData, 1)
UB1 = UBound(sheetData, 1)
LB2 = LBound(sheetData, 2)
UB2 = UBound(sheetData, 2)
For iRow = LB1 To UB1
service = sheetData(iRow, LB2)
For iColumn = (START_COLUMN - SERVICE_COLUMN + 1) To UB2
supplier = sheetData(LB1, iColumn)
price = sheetData(iRow, iColumn)
summaryCounter = summaryCounter + 1
ReDim Preserve summaryData(1 To 4, 1 To summaryCounter)
summaryData(1, summaryCounter) = service
summaryData(2, summaryCounter) = supplier
summaryData(3, summaryCounter) = priceRange
summaryData(4, summaryCounter) = price
Next iColumn
Next iRow
Next sheetCounter
Dim summarySheet As Workbook
Set summarySheet = ThisWorkbook.Worksheets(SUMMARY_SHEET_NAME)
Dim pasteRange As Range
With summarySheet
finalRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set pasteRange = .Range(.Cells(finalRow + 1, 1), .Cells(finalRow + summaryCounter, 4))
pasteRange = summaryData
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
MsgBox ("Complete")
End Sub
