Returning Column Header for first occurence of cell reference

Question

My raw data set is pretty straightforward.

• My columns run A-AM with a column header for each.
• There are no row labels.
• The data consists of serial numbers of varying lengths, from two to seven digits.

A serial number in one column will likely be repeated in several other columns. There are over one million entries with over seventy thousand unique serial numbers.

I ordered all of the serial numbers on a separate sheet in a column A .

What I would like is to populate column B with the corresponding column header of the serial numbers first occurrence in the array, from left to right. If possible, I'd like to have a similar formula in column C that shows the column header for the cell's last occurrence in the array (right to left).

The raw data looks like this. ( A1:H7 )

1974 1975 1976 1977 1978 1979 1980 1981

20 160 240 278 436 360 1696 1772

23 162 242 279 438 404 1698 1774

24 168 244 280 440 760 1700 1782

26 170 246 282 444 1620 1702 1784

28 188 248 283 449 1622 1706 1786

30 190 250 284 450 1624 1708 1788

Answer 1

Try this code:

Sub getOccurs()

    Dim findVal As String

    Dim wsUniqueSN As Worksheet
    Dim rngUniqueSN As Range
    Dim xlCell As Range

    Dim wsTarget As Worksheet
    Dim rngLastCell As Range
    Dim rngTarget As Range

    Dim rngFirstFound As Range
    Dim rngLastFound As Range

    Const notFound As String = "[ VALUE NOT FOUND!! ]"

    Set wsUniqueSN = ThisWorkbook.Worksheets("UniqueSN")
    Set wsTarget = ThisWorkbook.Worksheets("Data")

    Set rngUniqueSN = wsUniqueSN.Range("A1", wsUniqueSN.Range("A" & wsUniqueSN.Columns.Count).End(xlUp))

    Set rngLastCell = wsTarget.Range("H" & wsTarget.Rows.Count)
    'Use this if all columns contain the same number of rows to speed up the operation
    'Set rngLastCell = wsTarget.Range("H" & wsTarget.Rows.Count).End(xlUp)

    Set rngTarget = wsTarget.Range("A2", rngLastCell)

    For Each xlCell In rngUniqueSN

        findVal = xlCell.Value

        Set rngFirstFound = rngTarget.Find(What:=findVal, LookIn:=xlValues, LookAt:=xlWhole, _
                                                MatchCase:=True, SearchOrder:=xlByColumns, After:=rngLastCell)

            Set rngLastFound = rngTarget.Find(What:=findVal, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True, SearchOrder:=xlByColumns, _
                                                After:=rngLastCell, SearchDirection:=xlPrevious)

        If Not rngFirstFound Is Nothing Then
            xlCell.Offset(0, 1).Value = wsTarget.Cells(1, rngFirstFound.Column).Value
        Else
            xlCell.Offset(0, 1).Value = notFound
        End If

        If Not rngLastFound Is Nothing Then
            xlCell.Offset(0, 2).Value = wsTarget.Cells(1, rngLastFound.Column).Value
        Else
            xlCell.Offset(0, 2).Value = notFound
        End If

    Next xlCell

    MsgBox "Operation complete.", vbInformation

End Sub

Call your Data worksheet "Data" and the sheet containing Unique Serial Numbers UniqueSN, making sure that the SN are in column A. The macro will loop through the SN used range and look for the corresponding entries both in forward and in reverse order, writing the respective column headers in columns B and C.