In my worksheet, I have four different categories. For each category, there are
3~5 different prices. There are other attributes as well. As a result, each categories are duplicated many times and there are 30,000 rows in total. The first row of the worksheet have all the column names. Each category spans over consecutive rows. Therefore, I wrote the following function to identify “blocks” and calculate the min of the “blocks”.
Public Function blockMin(rng_temp As Range) As Integer Dim currRow As Long currRow = rng_temp.Row 'Find Category col Dim rng As Range Dim cabin_col As Long Dim price_col As Long For Each rng In Range("1:1") If rng.Value = "Cat" Then cat_col = rng.Column End If If rng.Value = "Price" Then pric_col = rng.Column End If Next rng Dim cat_col_char, price_col As String cat_col_char = Number2Letter(cat_col) price_col_char = Number2Letter(price_col) ' Find last row of the usedRange Dim lastRow As Long lastRow = findLastRow() 'Where the block is for each cat Dim startRow, endRow As Long startRow = rng_temp.Row endRow = rng_temp.Row 'Find Top Do While startRow >= 2 If Range(cat_col_char & startRow).Value <> Range(cat_col_char & currRow) Then startRow = startRow + 1 Exit Do End If startRow = startRow - 1 Loop If startRow = 1 Then startRow = 2 ' at the very top 'Find Bottom Do While endRow <= lastRow - 1 If Range(cat_col_char & endRow).Value <> Range(cat_col_char & currRow) Then endRow = endRow - 1 Exit Do End If endRow = endRow + 1 Loop If endRow = lastRow - 1 Then endRow = lastRow ' at the very bottom 'Return min of the block Dim block As Range Set block = Range(price_col_char & startRow & ":" & price_col_char & endRow) blockMin = Application.WorksheetFunction.Min(block) End Function
When I call the formula for a single cell, it is pretty fast. However, I have to call the UDF for 30,000 cells and that takes up to five minutes for every single calculation refresh. I was wondering if there are some room of improvements for run-time. Or, if there is a better way to work around it with built-in formula.
Thank you so much.
Something like this would be a little faster:
Public Function blockMin(rng_temp As Range) As Integer 'double? Dim sht As Worksheet, rS As Long, rE As Long, cat, v Dim hdrs, i As Long Dim cat_col As Long, price_col As Long Set sht = rng_temp.Worksheet '<<< scope all references to this sheet ' or you'll get odd results when a different ' sheet is active rS = rng_temp.Row rE = rS 'Find headers hdrs = sht.Range("A1").Resize(1, 100).Value 'limit your search range For i = 1 To UBound(hdrs, 2) v = hdrs(1, i) If cat_col = 0 And v = "Cat" Then cat_col = i If price_col = 0 And v = "Price" Then price_col = i If cat_col > 0 And price_col > 0 Then cat = rng_temp.EntireRow.Cells(cat_col).Value If Len(cat) > 0 Then 'find start/end rows Do While rS > 1 And sht.Cells(rS, cat_col) = cat rS = rS - 1 Loop Do While sht.Cells(rE, cat_col) = cat rE = rE + 1 Loop blockMin = Application.Min(sht.Range(sht.Cells(rS + 1, price_col), _ sht.Cells(rE - 1, price_col))) End If Exit For End If Next i End Function