Special count

[RIC63]

Moorning,

I am working with excel 2021 and 2024

With reference to the attached file

I would like in row 6 the count of how many values ​​are found in each column - starting from the top and searching downwards - before encountering one of the values ​​in range A2÷E2 and in row 7 the count of how many values ​​are found in each column - starting from the bottom 'always from row 22' and searching upwards - before encountering one of the values ​​in range A2÷E2 ...I manually entered the expected values

I tried to find examples with count.if but I am not able to build a valid macro, if anyone has a suggestion

thanks in advance

[arnelgp]

on column B there is a formula, I will leave the rest to you.

[Aussiebear]

This could be a swing and a miss.... so while we wait for the good guys to turn up, this might give you an idea or two



Sub FindValuesAndPlaceCountsInRows6and7_RevisedLookup()
Dim ws As Worksheet
Dim searchRange As Range
Dim lookupRange As Range
Dim col As Range
Dim cell As Range
Dim foundValue As Variant
Dim topToBottomCount As Long
Dim bottomToTopCount As Long
Dim i As Long
' For column iteration index
Dim firstFoundTopToBottom As Boolean
Dim firstFoundBottomToTop As Boolean
' Set the worksheet
Set ws = ThisWorkbook.Sheets("Sheet1") ' Adjust "Sheet1" to your actual sheet name
' Define the search range (B8:Q22)
Set searchRange = ws.Range("B8:Q22")
' Define the lookup range (A2:E2)
Set lookupRange = ws.Range("A2:E2")
' Clear previous results in rows 6 and 7 within the search columns
' Adjust this range clearing if your search range changes
ws.Range(ws.Cells(6, searchRange.Column), ws.Cells(7, searchRange.Columns.Count + searchRange.Column - 1)).ClearContents
' Loop through each column in the search range by index to easily target output columns
For i = 1 To searchRange.Columns.Count
' i represents the column index within searchRange
Set col = searchRange.Columns(i)
' Get the actual column object
firstFoundTopToBottom = False
' Reset flag for each new column
firstFoundBottomToTop = False
' Reset flag for each new column
' TOP TO BOTTOM Search
For Each cell In col.Cells
' Loop from top (Row 8) to bottom (Row 22)
On Error Resume Next
' Handle case where Match doesn't find a value
foundValue = Application.Match(cell.Value, lookupRange, 0)
On Error GoTo 0
' Re-enable error handling
If Not IsError(foundValue) Then
' If a match was found
' This is the first occurrence from top to bottom in this column
topToBottomCount = cell.Row - searchRange.Row
ws.Cells(6, col.Column).Value = topToBottomCount
firstFoundTopToBottom = True
Exit For
' Stop searching this column for top-to-bottom once the first is found
End If
Next cell
' BOTTOM TO TOP Search
' Loop from the last cell in the column upwards
For Each cell In col.Cells.Rows.Reverse
' Iterate through cells in reverse order
On Error Resume Next
' Handle case where Match doesn't find a value
foundValue = Application.Match(cell.Value, lookupRange, 0)
On Error GoTo 0
' Re-enable error handling
If Not IsError(foundValue) Then
' If a match was found
' This is the first occurrence from bottom to top in this column
' Calculate Bottom-to-Top count
' The count is the total number of cells in the search portion of the column minus the 0-based index of the found cell from the top, minus 1
bottomToTopCount = searchRange.Rows.Count - (cell.Row - searchRange.Row) - 1
ws.Cells(7, col.Column).Value = bottomToTopCount firstFoundBottomToTop = True
Exit For
' Stop searching this column for bottom-to-top once the first is found
End If
Next cell
' Optional: If no value found for a direction, you could put "N/A" or leave blank
' If Not firstFoundTopToBottom Then ws.Cells(6, col.Column).Value = "N/A"
' If Not firstFoundBottomToTop Then ws.Cells(7, col.Column).Value = "N/A"
Next i
' Move to the next column in the search range
MsgBox "Search complete! Counts are in rows 6 and 7 of the respective columns (B to Q).", vbInformation
End Sub

[georgiboy]

These should work in 2021 & 2024 versions (I think)

Row 6 formula:

=LET(d,B8:B22,a,MIN(IFNA(MATCH($A$2:$E$2,d,0),99)),IF(a=99,0,a-1))

Row 7 formula:

=LET(d,FILTER(B8:B22,B8:B22<>""),a,MAX(IFNA(MATCH($A$2:$E$2,d,0),0)),IF(a=0,0,ROWS(d)-a))

[RIC63]

thanks for your support, i find your solution through the function really fast, it does exactly what i wanted
thanks again

[RIC63]

hi Aussiebear

with your code I get the error 'property or method not supported by the object' on the line 52 where there is:

For Each cell In col.Cells.Rows.Reverse

thanks anyway for the support

[RIC63]

Hi georgiboy
Due to the data separator in use on my pc (; instead of ,) I can't use your formula because I can't understand exactly where to replace the , with the ;
thanks anyway

[Paul_Hossler]

You said you were looking for a macro

My (very) personal preferance is for user defined functions since I find them easier to read than long, complicated formulas

I put them at the bottom of your data range




Option Explicit


Function FindCheck(rCheck As Range, rTest As Range, TopDown As Boolean) As Long
Dim i As Long, j As Long
Dim aryCheck As Variant, aryTest As Variant

'put rangess into arrays for speen
With Application.WorksheetFunction
aryCheck = .Transpose(.Transpose(rCheck.Value)) ' 1 Row x n Cols
aryTest = .Transpose(rTest.Value) ' n Rows x 1 Col
End With


'make check values = -1 as marker
For i = LBound(aryCheck) To UBound(aryCheck)
For j = LBound(aryTest) To UBound(aryTest)
If aryTest(j) = aryCheck(i) Then
aryTest(j) = -1
Exit For
End If
Next j
Next i

'get rid of empty cells
For j = UBound(aryTest) To LBound(aryTest) Step -1
If aryTest(j) = 0 Then
ReDim Preserve aryTest(LBound(aryTest) To UBound(aryTest) - 1)
End If
Next j

FindCheck = 0

If TopDown Then
'boundry condition
If aryTest(LBound(aryTest)) = -1 Then Exit Function

'go down looking for -1 marker
For j = LBound(aryTest) + 1 To UBound(aryTest)
If aryTest(j) = -1 Then
FindCheck = j - 1
Exit Function
End If
Next j


Else
'boundry conhdition
If aryTest(UBound(aryTest)) = -1 Then Exit Function

'go up looking for-1 marker
For j = UBound(aryTest) To LBound(aryTest) Step -1
If aryTest(j) = -1 Then
FindCheck = UBound(aryTest) - j
Exit Function
End If
Next j
End If


End Function

[georgiboy]

Hi georgiboy
Due to the data separator in use on my pc (; instead of ,) I can't use your formula because I can't understand exactly where to replace the , with the ;
thanks anyway

Just for completeness you would replace all of the commas for semicolons.

[Aussiebear]

Note to one's self.... just because you have some spare time, you don't need to write novels when a formula will work. :jail:

[Aussiebear]

Look at the ball next time you swing Aussie..


Sub FindValuesAndPlaceCountsInRows6and7()
Dim ws As Worksheet
Dim searchRange As Range
Dim lookupRange As Range
Dim col As Range
Dim cell As Range
Dim foundValue As Variant
Dim topToBottomCount As Long
Dim bottomToTopCount As Long
Dim i As Long
' For column iteration index
Dim j As Long
' For row iteration index (bottom-to-top)
Dim firstFoundTopToBottom As Boolean
Dim firstFoundBottomToTop As Boolean
Dim currentRow As Long
' To get the absolute row number
' Set the worksheet
Set ws = ThisWorkbook.Sheets("Sheet1") ' Adjust "Sheet1" to your actual sheet name
' Define the search range (B8:Q22)
Set searchRange = ws.Range("B8:Q22")
' Define the lookup range (A2:E2)
Set lookupRange = ws.Range("A2:E2")
' Clear previous results in rows 6 and 7 within the search columns
' This clears from the starting column of searchRange (e.g., B) to its last column (e.g., Q)
ws.Range(ws.Cells(6, searchRange.Column), ws.Cells(7, searchRange.Columns.Count + searchRange.Column - 1)).ClearContents
' Loop through each column in the search range by index to easily target output columns
For i = 1 To searchRange.Columns.Count ' i represents the column index within searchRange
Set col = searchRange.Columns(i)
' Get the actual column object (e.g., Range("B8:B22"))
' TOP TO BOTTOM Search
' Loop from top (Row 8) to bottom (Row 22)
For Each cell In col.Cells
' This loop is correct as it iterates top-down
On Error Resume Next
' Handle case where Match doesn't find a value
foundValue = Application.Match(cell.Value, lookupRange, 0)
On Error GoTo 0
' Re-enable error handling
If Not IsError(foundValue) Then
' If a match was found
' This is the first occurrence from top to bottom in this column
topToBottomCount = cell.Row - searchRange.Row ws.Cells(6, col.Column).Value = topToBottomCount
Exit For
' Stop searching this column for top-to-bottom once the first is found
End If
Next cell
' BOTTOM TO TOP Search
' Loop from the last row of the column upwards to the first row of the column
For j = col.Rows.Count To 1 Step -1
' Iterate from the last cell (index 15) down to the first (index 1)
' Get the actual cell object for the current row in the column
Set cell = col.Cells(j)
On Error Resume Next
' Handle case where Match doesn't find a value
foundValue = Application.Match(cell.Value, lookupRange, 0)
On Error GoTo 0
' Re-enable error handling
If Not IsError(foundValue) Then
' If a match was found
' Calculate Bottom-to-Top count
' The count is the total number of cells in the search portion of the column minus the 0-based index of the found cell from the top, minus 1
bottomToTopCount = searchRange.Rows.Count - (cell.Row - searchRange.Row) - 1 ws.Cells(7, col.Column).Value = bottomToTopCount
Exit For
' Stop searching this column for bottom-to-top once the first is found
End If
Next j
' Use j for the row loop counter
Next i
' Move to the next column in the search range
MsgBox "Search complete! Counts are in rows 6 and 7 of the respective columns (B to Q).", vbInformation
End Sub



and that's a poke in the eye for all them short hand formula writers....:devil2:

[Paul_Hossler]

and that's a poke in the eye for all them short hand formula writers....:devil2:

I avoid formulas that have more than 3 pairs of parens :thumb

I find hidden helper columns or UDFs more maintainable, but just me

[georgiboy]

I still write code but have found in the last few years that there are more succinct ways to create the same result with formula, especially with formula such as BYROW, BYCOL, MAP and SEQUENCE removing the need to write loops in VBA. These succinct formularised methods can also be a lot faster when speed testing the alternatives in VBA.

Below are two alternative formula that produce the same result as my last formula:

The first formula can be done with 3 pairs of parenthesis ;)

=MIN(XLOOKUP($A$2:$E$2,B8:B22,SEQUENCE(15,,0),"",0))

The second one can't, however, if you break it down by using the LET function, it is easy to manage/ see what is going on:

=LET(
f,FILTER(B8:B22,B8:B22<>""),
r,ROWS(f),
s,SEQUENCE(r,,r-1,-1),
x,XLOOKUP($A$2:$E$2,f,s,"",0,-1),
MIN(x)
)


I was thinking about writing a guide to using some of the new functions in Excel 365 and putting it in the Formula section of the forum, not sure how useful that would be here and we are more of a VBA driven site?

[arnelgp]

i think that would be helpful, same as AI results from Copilot and ChatGpt.

[Aussiebear]

I was thinking about writing a guide to using some of the new functions in Excel 365 and putting it in the Formula section of the forum, not sure how useful that would be here and we are more of a VBA driven site?

That's true but we also assist others with excel forumla's as a primary interest.

[arnelgp]

who knows, maybe you will surpass Ms. Leila Gharani on Excel tutorials.

[georgiboy]

@arnelgp,

I doubt it but I am better looking than her.

I have used ChatGPT in the past for help with the new functions and it can be annoyingly wrong. For example setting variable names inside a LET function as 'AB1'. With that being a reference to a cell, it will cause an error. Also AI will quite often not give you the most efficient solution to a problem, quite often it will give you a formula that will never work and therefore can't be trusted to give a tutorial.