![]() |
Find string from column A in Range("B2:F7") list the header of that column/s
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 Secondly, in column J where the header is listed, I am struggling to get the cell address of "i" next to header name in column K. So an example would be in col J = Col_B_Header and in col K = $B$5 Regards, Howard Option Explicit Sub ListHeader() Dim lngLstRow As Long Dim rngA As Range, i As Range With Sheets("Sheet2") lngLstRow = .UsedRange.Rows.Count For Each rngA In .Range("A2:A" & lngLstRow) For Each i In Range("B2:F7") If i.Value = rngA Then .Range("J100").End(xlUp).Offset(1, 0) _ = i.Offset(Cells.End(xlUp), 0).Value End If Next Next End With End Sub |
Find string from column A in Range("B2:F7") list the header of that column/s
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 |
Find string from column A in Range("B2:F7") list the header ofthat column/s
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. Hi Claus, I think this is doing partly what I want, I'll have to test it further. The order of listing in Col J is confusing. Does the code look the column A items staeting from the bottom to the top? The part it does not do is there are no cell address' in column K of the "found column A item". Regards, Howard |
Find string from column A in Range("B2:F7") list the header of that column/s
Hi Howard,
Am Mon, 12 Aug 2013 01:22:52 -0700 (PDT) schrieb Howard: The part it does not do is there are no cell address' in column K of the "found column A item". sorry, I did not read carefully. 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, after:=.Range("F7")) If Not c Is Nothing Then firstaddress = c.Address Do .Cells(i, "J") = .Cells(1, c.Column) .Cells(i, "K") = c.Address 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 |
Find string from column A in Range("B2:F7") list the header of that column/s
Hi Howard,
Am Mon, 12 Aug 2013 01:22:52 -0700 (PDT) schrieb Howard: The order of listing in Col J is confusing. Does the code look the column A items staeting from the bottom to the top? the code looks from A2 to the bottom. For the search in B2:F7 you can fix the searchorder with Searchorder:=xlByRows or Searchorder:=xlByColumns Or you look in column A for the strings in B2:F7: Sub ListHeader3() 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("B2:F7") Set c = .Range("A2:A" & lngLstRow).Find(rngA, _ LookIn:=xlValues, after:=.Range("A" & lngLstRow)) If Not c Is Nothing Then firstaddress = c.Address Do .Cells(i, "J") = .Cells(1, rngA.Column) .Cells(i, "K") = rngA.Address i = i + 1 Set c = .Range("A2:A" & lngLstRow).FindNext(c) Loop While Not c Is Nothing And c.Address < firstaddress End If Next lngLstRow = .Cells(Rows.Count, "J").End(xlUp).Row .Range("J1:K" & lngLstRow).RemoveDuplicates _ Columns:=Array(1, 2), Header:=xlNo End With End Sub Regards Claus B. -- Win XP PRof SP2 / Vista Ultimate SP2 Office 2003 SP2 /2007 Ultimate SP2 |
Find string from column A in Range("B2:F7") list the header ofthat column/s
On Monday, August 12, 2013 1:37:35 AM UTC-7, Claus Busch wrote:
Hi Howard, Am Mon, 12 Aug 2013 01:22:52 -0700 (PDT) schrieb Howard: The part it does not do is there are no cell address' in column K of the "found column A item". sorry, I did not read carefully. 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, after:=.Range("F7")) If Not c Is Nothing Then firstaddress = c.Address Do .Cells(i, "J") = .Cells(1, c.Column) .Cells(i, "K") = c.Address 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. Very nice, and with the cell address' it is easy see to the lookup order, which is, of course, is as you have said. The order is not important, but thanks for taking the time enlighten me. Thanks again. Regards, Howard |
All times are GMT +1. The time now is 02:02 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com