Using VBA to get a threshold value - vba

Question

I have a column A and a column B. In column A, I have (starting in A2) values that go from 1-150 (so ending in A151)
In column B, I have values. I want to get the first value that is above the value in cell Z2 and write out the corresponing value in the A column in cell B153 for column B. Last part is tricky. I only want to write this value if the following 4 values are also above the value in Z2. Is this possible to d?
If this is, I also have the same thing in columns C-Y
Better explanation:
I want to loop through columns B-Y
Inner loop from cells 2-151.
If B2>Z2 but also next 4 sequential cells (B3-B6)>Z2, then copy A2 to B153 and move to next column.
If B2 > Z2 but next 4 are not all > Z2, repeat process with B3.
If B2 < Z2, move to B3.
If none is true copy N/A to B153
Can this be done?
My first attempt:
=INDEX($A$2:$A$151,SUMPRODUCT(MATCH(1,--(B$2:B$151>$Z$2),0)),1)
This takes the first value though. I'm trying to think of a clever way to take the first value only if the second value also meets criteria. From there I'm sure I can expand to 3rd, 4th, 5th, etc.

Answer 1

There are a lot of ways to solve this, but in my opinion you need a nested loop in a user-defined function.
We can...
function get_Energy_Row(cellSearch as Range, staticValue as Single)
Dim cell1 as Single
get_Energy_Row = "N/A"
j = 1
col = cellSearch.Columns.Count
Do
cell1 = cellSearch(j, col)
If cell1 <= staticValue Then
'do nothing, function already set to "N/A"
Else
For i = 1 to 4
If cellSearch(i + j, col) > staticValue Then
get_Energy_Row = cellSearch(j,1)
Else
'do nothing, function already set to "N/A"
End If
Next i
End If
j = j + 1
Loop Until j >= cellSearch.Rows.Count - 3 Or get_Energy_Row <> "N/A"
End Function
Then call your UDF in cell C153 like this:
=get_Energy_Row($A2:B151,$Z$2), where you encompass the first column.
Note the dollar signs, this will ensure that your static check will always be Z2
The logic is that I default the cell to "N/A" until it finds a criteria that overwrites "N/A", in which case the loop is broken.

Answer 2

Your current formula might work for the single value case but I think it would be a littly clumsy to try to scale up. A couple quick ways to accomplish this via formula are:
=MIN(IF(COUNTIF(INDIRECT("B"&ROW(2:147)&":B"&ROW(6:151)),">"&Z2)=5,$A2:$A147,1E9))
And:
=MIN(IF((B2:B147>Z2)*(B3:B148>Z2)*(B4:B149>Z2)*(B5:B150>Z2)*(B6:B151>Z2),$A2:$A147,1E9))
Personally I think the latter is easier to read and drag through the spreadsheet (though the former could be modified to drag just as easily). The latter also avoids the volatile INDIRECT function. The first function takes 5 cell ranges at a time and counts the number of cells that match the criteria. If our count is 5, we have a match. This method is preferred if you are looking for larger sets of matches. The second formula just steps through the range checking basically r through r+4 where r is the current row. Both are array formulas that should be entered with CTRL + SHIFT + ENTER instead of just ENTER.

Answer 3

Something like this:
Sub OutputEnergy()
'y = Columns to check: 2-25
'x = Rows to check: 2-152
'z = check the next 4 cells
Dim x, y, z, check
'Clear the range where we store the #N/A or Energy Outputs
Range("B153:Y153") = vbNullString
For y = 2 To 25
For x = 2 To 152
If Cells(x, y) > Range("Z2") Then 'If value is greater than Z2
check = True 'Let's check the next 4
For z = 1 To 4 'If any of them fail
If Cells(x + z, y) < Range("Z2") Then
check = False 'The check fails
Exit For
End If
Next z
If check = True Then 'If the check doesn't fail
Cells(153, y) = Cells(x, 1) 'Set cell 153 to the energy level
Exit For
End If
End If
Next x 'If no energy level was set - #N/A
If Cells(153, y) = vbNullString Then Cells(153, y) = "#N/A"
Next y
End Sub
Edit: As a function:
Function Usage:
=OutputEnergy(Range, Threshold, [Number of cells to check], [Using Headers?])
Basically, give it the range to check, give it a threshold.
The number of cells to check afterwards is 4 by default.
To get the "Energy" it gets the row number (If using headers, it subtracts 1)
Function OutputEnergy(TheRange As Range, Threshold As Variant, Optional NextCells As Integer = 4, Optional OffsetForHeader As Boolean = True) As Variant
Dim c, x, check
For Each c In TheRange
If c.Value > Threshold Then
check = True
For x = 1 To NextCells
If c.Offset(x, 0) < Threshold Then
check = False
Exit For
End If
Next x
If check = True Then
OutputEnergy = IIf(OffsetForHeader, c.Row - 1, c.Row)
Exit Function
End If
End If
Next c
OutputEnergy = CVErr(xlErrNA)
End Function
Edit again - to output to all sheets:
OutputEnergyToSheet accepts a sheet as a parameter:
Sub OutputEnergyToSheet(TheSheet As String)
'y = Columns to check: 2-25
'x = Rows to check: 2-152
'z = check the next 4 cells
Dim x, y, z, check
'Clear the range where we store the #N/A or Energy Outputs
With Sheets(TheSheet)
.Range("B153:Y153") = vbNullString
For y = 2 To 25
For x = 2 To 152
If .Cells(x, y) > .Range("Z2") Then 'If value is greater than Z2
check = True 'Let's check the next 4
For z = 1 To 5 'If any of them fail
If .Cells(x + z, y) < .Range("Z2") Then
check = False 'The check fails
Exit For
End If
Next z
If check = True Then 'If the check doesn't fail
.Cells(153, y) = Int(.Cells(x, 1)) 'Set cell 153 to the energy level
Exit For
End If
End If
Next x 'If no energy level was set - #N/A
If .Cells(153, y) = vbNullString Then .Cells(153, y) = "#N/A"
Next y
End With
End Sub
OutputEnergyToAllSheets loops through each sheet and calls the new sub:
Sub OutputEnergyToAllSheets()
Dim w
For Each w In ThisWorkbook.Worksheets
If Not InStr(w.Name, "Total") > 0 And Not InStr(w.Name, "eV") > 0 Then
OutputEnergyToSheet w.Name
End If
Next w
End Sub