# Return column header name if value in that row



## surkdidat (Dec 22, 2022)

Hi all


In Sheet 1, Column I, is a reference number (starting row 2) say, 12345

In Sheet 1, Row 1 are the column headers, starting in Column Q (ending on Column ES)

In Sheet 2 in column A, i have a long list of reference numbers.

To save me a lot of manual labour, what i would like is to return EVERY column header against the reference number in sheet 2, that has a value in it.

To be slightly more difficult, I only need the word (or words) AFTER a // in the Column Header name (There are no spaces between the // and he value I need to extract.

What I need to extract can be one word, or more, and various lengths.

EDIT : To update Columns references


(SHEET 1)Column IColumn QColumn RColumn SColumn T(ROW 2)​ABC//HorseDEF//FoxGHI//DogIJK//Koala BearLMN//Rabbit23456njkloiojhjopgvyi34567hhhh12345fffghgoiopphgo080987654njninniin



(SHEET 2)12345HorseFoxDogKoala BearRabbit23456HorseDogKoala BearRabbit34567Fox87654FoxRabbit

I hope that explains everything, and my manual example matches!!


----------



## Peter_SSs (Dec 23, 2022)

surkdidat said:


> In Sheet 2 in column A, i have a long list of reference numbers.


I have assumed that list actually starts in row 2.

If so, then see how this goes with a *copy *of your workbook.


```
Sub List_Hdrs()
  Dim d As Object
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, r As Long, c As Long, uba2 As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  With Sheets("Sheet1")
    b = .Range("I1", .Range("I" & Rows.Count).End(xlUp)).Value
    For i = 2 To UBound(b)
      d(b(i, 1)) = i
    Next i
    With .Range("Q1:ES1")
      b = .Value
      .Replace What:="*//", Replacement:="", LookAt:=xlPart
      a = .Parent.Range("Q1:ES" & .Parent.Range("I" & Rows.Count).End(xlUp).Row).Value
      uba2 = UBound(a, 2)
      .Value = b
    End With
  End With
  With Sheets("Sheet2")
    b = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
    ReDim Preserve b(1 To UBound(b), 1 To uba2 + 1)
    For i = 1 To UBound(b)
      If d.exists(b(i, 1)) Then
        r = d(b(i, 1))
        c = 1
        For j = 1 To uba2
          If Len(a(r, j)) > 0 Then
            c = c + 1
            b(i, c) = a(1, j)
          End If
        Next j
      End If
    Next i
    .Range("A2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  End With
End Sub
```


----------

