CODEWITHSUNDEEP
excelvbaexcel-formula
americ998
americ998

Reputation: 69

Get names of non-blank columns for a certain value from first column

I have data that has 400 cols x 2000 rows:

Name Basket 1 Basket 2 Basket 3
Apple 30% 40% 45%
Banana 20% 55%
Orange 50% 60%

On another tab, I want, if I put 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.

Upvotes: 1

Views: 243

Answers (1)

VBasic2008
VBasic2008

Reputation: 54807

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

Upvotes: 1

Related Questions