Hi Howard,

Am Sun, 11 Aug 2013 23:52:31 -0700 (PDT) schrieb Howard:

From the list of items in column A, find each (if they exist) in Range("B2:F7") and list the header of that column (B1:F1) in column J. Column A items can occur under multiple headers in B1 to F1.

I'm sure this is the culprit line...

.Range("J100").End(xlUp).Offset(1, 0) = i.Offset(Cells.End(xlUp), 0).Value

try:
Sub ListHeader2()
Dim lngLstRow As Long
Dim rngA As Range
Dim c As Range
Dim firstaddress As String
Dim i As Long

i = 1
With Sheets("Sheet2")
lngLstRow = .UsedRange.Rows.Count
For Each rngA In .Range("A2:A" & lngLstRow)
Set c = .Range("B2:F7").Find(rngA, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
.Cells(i, "J") = .Cells(1, c.Column)
i = i + 1
Set c = .Range("B2:F7").FindNext(c)
Loop While Not c Is Nothing And c.Address < firstaddress
End If
Next
End With
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2