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