Special count

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

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

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

Code:

---

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

---

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

Row 6 formula:

Code:

---

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

---

Row 7 formula:

Code:

---

=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))

---

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

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

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

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

Code:

---

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

---

Quote:

---

Originally Posted by 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

---

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

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:

Look at the ball next time you swing Aussie..

Code:

---

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:

Quote:

---

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

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 ;)

Code:

---

=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:

Code:

---

=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?

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

Quote:

---

Originally Posted by georgiboy

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.

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

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