Sorry if title is confusing - not sure how to best describe it

I have data that has 400 cols x 2000 rows formatted like below:

On another tab, I want to make it so that if I put in Banana in a cell in A2, then B2 would be populated with Basket 1 (20%), Basket 3 (55%).

I've done this before by using if & isblank statements to display the column name if the cell is not blank for each row, but that is too manual for 400 columns. What would be the best way to approach this? Any help would be appreciated. Thank you!

CodePudding user response：

Get Delimited Data (UDF): Header and Row

• In Excel, in cell B2, use the following formula:

  =FruitByBasket(A2)
  

• Copy the following code to a standard module, e.g. Module1.

• Adjust the values in the constants section.

Option Explicit

Function FruitsByBasket( _
    ByVal Fruit As String) _
As String
    Application.Volatile

    Const wsName As String = "Sheet1"
    Const FruitColumn As String = "A"
    Const Delimiter As String = ", "
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim crg As Range: Set crg = ws.Columns(FruitColumn)
    
    Dim FruitRow As Variant: FruitRow = Application.Match(Fruit, crg, 0)
    If IsError(FruitRow) Then Exit Function
    
    Dim LastColumn As Long
    LastColumn = ws.Cells(FruitRow, ws.Columns.Count).End(xlToLeft).Column
    If LastColumn = 1 Then Exit Function
        
    Dim rrg As Range
    Set rrg = ws.Rows(FruitRow).Resize(, LastColumn - 1).Offset(, 1)
    
    Dim cCount As Long: cCount = rrg.Columns.Count
    
    Dim rData As Variant
    Dim hData As Variant
    
    If cCount = 1 Then
        ReDim rData(1 To 1, 1 To 1): rData(1, 1) = rrg.Value
        ReDim hData(1 To 1, 1 To 1)
        hData(1, 1) = rrg.EntireColumn.Rows(1).Value
    Else
        rData = rrg.Value
        hData = rrg.EntireColumn.Rows(1).Value
    End If
    
    Dim dLen As Long: dLen = Len(Delimiter)
    
    Dim c As Long
    For c = 1 To cCount
        If IsNumeric(rData(1, c)) Then
            If Len(rData(1, c)) > 0 Then
                FruitsByBasket = FruitsByBasket & hData(1, c) & " (" _
                    & Format(rData(1, c), "#%") & ")" & Delimiter
            End If
        End If
    Next c
    
    If Len(FruitsByBasket) > 0 Then
        FruitsByBasket = Left(FruitsByBasket, Len(FruitsByBasket) - dLen)
    End If
        
End Function