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”.

Example Image of How Cat Blocks Look Like

```
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
```

Tags: excelexcel, vba