Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Checking sheet for values and capturing column name
It's weird that every time I think I'm going to know how to do something, it
winds up I get 1/4 or 1/2 way there and then stuck. On Sheet1 I have one column of text values (about 500) in Column A (w/ header of "Unique"). On Sheet2 there are many columns and many rows, with all kinds of values everywhere. What I need to do is: Run through Sheet2, and for every occurrence of a value in Sheet1's "Unique" column, enter the column heading(s) of the column(s) that value is in in Column 2 of Sheet1 next to that value. For instance, Sheet1's "Unique" column has: Gear Tranny Door On Sheet2: - The value "Gear" is located in A5 (Column heading of "Parts"), E114 (Column heading of "Labor"), and G55 (Column heading of "Misc"). - The value "Tranny" is in B45 (Column heading of "Traps") - The value "Door" is in A88 (Column heading of "Parts") and E6 (Column heading of "Labor"). So, after I run a sub procedure, Sheet1 should show the following: Gear Parts,Labor,Misc Tranny Traps Door Parts, Labor I don't care if it's easier to put each column header instance in a separate column on Sheet1 (instead of values separated by commas), because I can combine them as a separate step. Also, if getting the actual column header value is a big complication, I don't mind just returning the column letters and then I can run a sub or use a formula to change column letters to their respective header names as a separate step also. Can anyone help me figure out how to do this? Any help is greatly appreciated, and thanks for reading. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Checking sheet for values and capturing column name
Option Explicit
Sub GetcolumnHeaders() Dim fAddr As String Dim sStr As String, s As String Dim rng As Range Dim rng2 As Range Dim cell As Range Dim cell1 As Range With Worksheets("Sheet1") Set rng = .Range(.Range("A2"), _ .Range("A2").End(xlDown)) End With For Each cell In rng Set rng2 = Nothing sStr = cell.Value With Worksheets("sheet2").Cells Set rng = .Find( _ What:=sStr, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not rng Is Nothing Then fAddr = rng.Address Do If rng2 Is Nothing Then Set rng2 = rng Else Set rng2 = Application.Union(rng2, rng) End If Set rng = .FindNext(rng) Loop While rng.Address < fAddr End If cell.Offset(0, 1).ClearContents s = "" If Not rng2 Is Nothing Then For Each cell1 In rng2 s = s & _ cell1.Parent.Cells(1, _ cell1.Column) & "," Next cell.Offset(0, 1).Value = Left(s, Len(s) - 1) End If End With Next End Sub -- Regards, Tom Ogilvy "Complete Newb" wrote: It's weird that every time I think I'm going to know how to do something, it winds up I get 1/4 or 1/2 way there and then stuck. On Sheet1 I have one column of text values (about 500) in Column A (w/ header of "Unique"). On Sheet2 there are many columns and many rows, with all kinds of values everywhere. What I need to do is: Run through Sheet2, and for every occurrence of a value in Sheet1's "Unique" column, enter the column heading(s) of the column(s) that value is in in Column 2 of Sheet1 next to that value. For instance, Sheet1's "Unique" column has: Gear Tranny Door On Sheet2: - The value "Gear" is located in A5 (Column heading of "Parts"), E114 (Column heading of "Labor"), and G55 (Column heading of "Misc"). - The value "Tranny" is in B45 (Column heading of "Traps") - The value "Door" is in A88 (Column heading of "Parts") and E6 (Column heading of "Labor"). So, after I run a sub procedure, Sheet1 should show the following: Gear Parts,Labor,Misc Tranny Traps Door Parts, Labor I don't care if it's easier to put each column header instance in a separate column on Sheet1 (instead of values separated by commas), because I can combine them as a separate step. Also, if getting the actual column header value is a big complication, I don't mind just returning the column letters and then I can run a sub or use a formula to change column letters to their respective header names as a separate step also. Can anyone help me figure out how to do this? Any help is greatly appreciated, and thanks for reading. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Checking sheet for values and capturing column name
One way:
Public Sub ListUniqueHeaders() Dim rCell As Range Dim rUnique As Range Dim rFound As Range Dim sColumnHeaders As String Dim sFirstAddress As String With Worksheets("Sheet1") Set rUnique = .Cells.Find( _ What:="Unique", _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ Lookat:=xlWhole, _ MatchCase:=False) If rUnique Is Nothing Then MsgBox "'Unique' column not found)" Exit Sub Else Set rUnique = .Range(rUnique.Offset(1, 0), _ .Cells(.Rows.Count, rUnique.Column).End(xlUp)) If rUnique.Cells.Count = 1 Then MsgBox "No values in 'Unique' column" Exit Sub End If End If End With With Sheets("Sheet2") For Each rCell In rUnique Set rFound = .Cells.Find( _ What:=rCell.Text, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ Lookat:=xlPart, _ MatchCase:=False) If Not rFound Is Nothing Then sFirstAddress = rFound.Address Do sColumnHeaders = sColumnHeaders & "," & _ rFound.EntireColumn.Cells(1).Text Set rFound = .Cells.FindNext(After:=rFound) Loop Until rFound.Address = sFirstAddress rCell.Offset(0, 1).Value = Mid(sColumnHeaders, 2) sColumnHeaders = vbNullString Set rFound = Nothing End If Next rCell End With End Sub In article , "Complete Newb" wrote: It's weird that every time I think I'm going to know how to do something, it winds up I get 1/4 or 1/2 way there and then stuck. On Sheet1 I have one column of text values (about 500) in Column A (w/ header of "Unique"). On Sheet2 there are many columns and many rows, with all kinds of values everywhere. What I need to do is: Run through Sheet2, and for every occurrence of a value in Sheet1's "Unique" column, enter the column heading(s) of the column(s) that value is in in Column 2 of Sheet1 next to that value. For instance, Sheet1's "Unique" column has: Gear Tranny Door On Sheet2: - The value "Gear" is located in A5 (Column heading of "Parts"), E114 (Column heading of "Labor"), and G55 (Column heading of "Misc"). - The value "Tranny" is in B45 (Column heading of "Traps") - The value "Door" is in A88 (Column heading of "Parts") and E6 (Column heading of "Labor"). So, after I run a sub procedure, Sheet1 should show the following: Gear Parts,Labor,Misc Tranny Traps Door Parts, Labor I don't care if it's easier to put each column header instance in a separate column on Sheet1 (instead of values separated by commas), because I can combine them as a separate step. Also, if getting the actual column header value is a big complication, I don't mind just returning the column letters and then I can run a sub or use a formula to change column letters to their respective header names as a separate step also. Can anyone help me figure out how to do this? Any help is greatly appreciated, and thanks for reading. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Checking sheet for values and capturing column name
Tom:
That was amazing; totally worked. Tom, you continue to carry a significant amount of us newbies. I still have several examples you provided on the newsgroups a long time ago (not trying to say you're old or anything), that I continue to use as the basis for my own modifications when I need to execute similar, but different, tasks. I have one questions about the results of this; I had not anticipated that many of these values would actually be in ONE column several times. Is there a way to either: - Tell the VBA in your example to ignore multiple identical instances or - (and this one would probably be easier) Delete duplicate values in each cell's comma-delimited list in the results sheet (ie. "Labor,Labor,Labor,Parts" would become "Labor,Parts") Again, thank you very much. "Tom Ogilvy" wrote in message ... Option Explicit Sub GetcolumnHeaders() Dim fAddr As String Dim sStr As String, s As String Dim rng As Range Dim rng2 As Range Dim cell As Range Dim cell1 As Range With Worksheets("Sheet1") Set rng = .Range(.Range("A2"), _ .Range("A2").End(xlDown)) End With For Each cell In rng Set rng2 = Nothing sStr = cell.Value With Worksheets("sheet2").Cells Set rng = .Find( _ What:=sStr, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not rng Is Nothing Then fAddr = rng.Address Do If rng2 Is Nothing Then Set rng2 = rng Else Set rng2 = Application.Union(rng2, rng) End If Set rng = .FindNext(rng) Loop While rng.Address < fAddr End If cell.Offset(0, 1).ClearContents s = "" If Not rng2 Is Nothing Then For Each cell1 In rng2 s = s & _ cell1.Parent.Cells(1, _ cell1.Column) & "," Next cell.Offset(0, 1).Value = Left(s, Len(s) - 1) End If End With Next End Sub -- Regards, Tom Ogilvy "Complete Newb" wrote: It's weird that every time I think I'm going to know how to do something, it winds up I get 1/4 or 1/2 way there and then stuck. On Sheet1 I have one column of text values (about 500) in Column A (w/ header of "Unique"). On Sheet2 there are many columns and many rows, with all kinds of values everywhere. What I need to do is: Run through Sheet2, and for every occurrence of a value in Sheet1's "Unique" column, enter the column heading(s) of the column(s) that value is in in Column 2 of Sheet1 next to that value. For instance, Sheet1's "Unique" column has: Gear Tranny Door On Sheet2: - The value "Gear" is located in A5 (Column heading of "Parts"), E114 (Column heading of "Labor"), and G55 (Column heading of "Misc"). - The value "Tranny" is in B45 (Column heading of "Traps") - The value "Door" is in A88 (Column heading of "Parts") and E6 (Column heading of "Labor"). So, after I run a sub procedure, Sheet1 should show the following: Gear Parts,Labor,Misc Tranny Traps Door Parts, Labor I don't care if it's easier to put each column header instance in a separate column on Sheet1 (instead of values separated by commas), because I can combine them as a separate step. Also, if getting the actual column header value is a big complication, I don't mind just returning the column letters and then I can run a sub or use a formula to change column letters to their respective header names as a separate step also. Can anyone help me figure out how to do this? Any help is greatly appreciated, and thanks for reading. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Checking sheet for values and capturing column name
JE:
Thanks for offering that VBA. From the looks of it, this would actually address the issue with multiple identical column header entries (like if a value from Sheet1 happens to be in A5, A10, A122, etc.). However, when I try it, it just goes to the msgbox saying no unique values found, which I know can't be the case. I made sure the sheet titles are correct; do you know why the check returns the msgbox? Thanks again, your help is very much appreciated. "JE McGimpsey" wrote in message ... One way: Public Sub ListUniqueHeaders() Dim rCell As Range Dim rUnique As Range Dim rFound As Range Dim sColumnHeaders As String Dim sFirstAddress As String With Worksheets("Sheet1") Set rUnique = .Cells.Find( _ What:="Unique", _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ Lookat:=xlWhole, _ MatchCase:=False) If rUnique Is Nothing Then MsgBox "'Unique' column not found)" Exit Sub Else Set rUnique = .Range(rUnique.Offset(1, 0), _ .Cells(.Rows.Count, rUnique.Column).End(xlUp)) If rUnique.Cells.Count = 1 Then MsgBox "No values in 'Unique' column" Exit Sub End If End If End With With Sheets("Sheet2") For Each rCell In rUnique Set rFound = .Cells.Find( _ What:=rCell.Text, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ Lookat:=xlPart, _ MatchCase:=False) If Not rFound Is Nothing Then sFirstAddress = rFound.Address Do sColumnHeaders = sColumnHeaders & "," & _ rFound.EntireColumn.Cells(1).Text Set rFound = .Cells.FindNext(After:=rFound) Loop Until rFound.Address = sFirstAddress rCell.Offset(0, 1).Value = Mid(sColumnHeaders, 2) sColumnHeaders = vbNullString Set rFound = Nothing End If Next rCell End With End Sub In article , "Complete Newb" wrote: It's weird that every time I think I'm going to know how to do something, it winds up I get 1/4 or 1/2 way there and then stuck. On Sheet1 I have one column of text values (about 500) in Column A (w/ header of "Unique"). On Sheet2 there are many columns and many rows, with all kinds of values everywhere. What I need to do is: Run through Sheet2, and for every occurrence of a value in Sheet1's "Unique" column, enter the column heading(s) of the column(s) that value is in in Column 2 of Sheet1 next to that value. For instance, Sheet1's "Unique" column has: Gear Tranny Door On Sheet2: - The value "Gear" is located in A5 (Column heading of "Parts"), E114 (Column heading of "Labor"), and G55 (Column heading of "Misc"). - The value "Tranny" is in B45 (Column heading of "Traps") - The value "Door" is in A88 (Column heading of "Parts") and E6 (Column heading of "Labor"). So, after I run a sub procedure, Sheet1 should show the following: Gear Parts,Labor,Misc Tranny Traps Door Parts, Labor I don't care if it's easier to put each column header instance in a separate column on Sheet1 (instead of values separated by commas), because I can combine them as a separate step. Also, if getting the actual column header value is a big complication, I don't mind just returning the column letters and then I can run a sub or use a formula to change column letters to their respective header names as a separate step also. Can anyone help me figure out how to do this? Any help is greatly appreciated, and thanks for reading. |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Checking sheet for values and capturing column name
Glad you find some of my stuff useful:
Option Explicit Sub GetcolumnHeaders() Dim fAddr As String Dim sStr As String, s As String Dim rng As Range Dim rng2 As Range Dim cell As Range Dim cell1 As Range Dim cell2 As Range Dim nodupes As Collection Dim itm As Variant With Worksheets("Sheet1") Set rng = .Range(.Range("A2"), _ .Range("A2").End(xlDown)) End With For Each cell In rng Set rng2 = Nothing sStr = cell.Value With Worksheets("sheet2").Cells Set rng = .Find( _ What:=sStr, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not rng Is Nothing Then fAddr = rng.Address Do If rng2 Is Nothing Then Set rng2 = rng Else Set rng2 = Application.Union(rng2, rng) End If Set rng = .FindNext(rng) Loop While rng.Address < fAddr End If cell.Offset(0, 1).ClearContents s = "" If Not rng2 Is Nothing Then Set nodupes = New Collection For Each cell1 In rng2 Set cell2 = cell1.Parent.Cells(1, cell1.Column) On Error Resume Next nodupes.Add cell2.Value, cell2.Text On Error GoTo 0 Next ' ' Optional Sort code would go here ' For Each itm In nodupes s = s & itm & "," Next cell.Offset(0, 1).Value = Left(s, Len(s) - 1) End If End With Next End Sub should do it. If you want them sorted, see John Walkenbach's site http://www.j-walk.com/ss/excel/tips/tip47.htm see the sort collection part of the code. -- Regards, Tom Ogilvy "Complete Newb" wrote in message ... Tom: That was amazing; totally worked. Tom, you continue to carry a significant amount of us newbies. I still have several examples you provided on the newsgroups a long time ago (not trying to say you're old or anything), that I continue to use as the basis for my own modifications when I need to execute similar, but different, tasks. I have one questions about the results of this; I had not anticipated that many of these values would actually be in ONE column several times. Is there a way to either: - Tell the VBA in your example to ignore multiple identical instances or - (and this one would probably be easier) Delete duplicate values in each cell's comma-delimited list in the results sheet (ie. "Labor,Labor,Labor,Parts" would become "Labor,Parts") Again, thank you very much. "Tom Ogilvy" wrote in message ... Option Explicit Sub GetcolumnHeaders() Dim fAddr As String Dim sStr As String, s As String Dim rng As Range Dim rng2 As Range Dim cell As Range Dim cell1 As Range With Worksheets("Sheet1") Set rng = .Range(.Range("A2"), _ .Range("A2").End(xlDown)) End With For Each cell In rng Set rng2 = Nothing sStr = cell.Value With Worksheets("sheet2").Cells Set rng = .Find( _ What:=sStr, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not rng Is Nothing Then fAddr = rng.Address Do If rng2 Is Nothing Then Set rng2 = rng Else Set rng2 = Application.Union(rng2, rng) End If Set rng = .FindNext(rng) Loop While rng.Address < fAddr End If cell.Offset(0, 1).ClearContents s = "" If Not rng2 Is Nothing Then For Each cell1 In rng2 s = s & _ cell1.Parent.Cells(1, _ cell1.Column) & "," Next cell.Offset(0, 1).Value = Left(s, Len(s) - 1) End If End With Next End Sub -- Regards, Tom Ogilvy "Complete Newb" wrote: It's weird that every time I think I'm going to know how to do something, it winds up I get 1/4 or 1/2 way there and then stuck. On Sheet1 I have one column of text values (about 500) in Column A (w/ header of "Unique"). On Sheet2 there are many columns and many rows, with all kinds of values everywhere. What I need to do is: Run through Sheet2, and for every occurrence of a value in Sheet1's "Unique" column, enter the column heading(s) of the column(s) that value is in in Column 2 of Sheet1 next to that value. For instance, Sheet1's "Unique" column has: Gear Tranny Door On Sheet2: - The value "Gear" is located in A5 (Column heading of "Parts"), E114 (Column heading of "Labor"), and G55 (Column heading of "Misc"). - The value "Tranny" is in B45 (Column heading of "Traps") - The value "Door" is in A88 (Column heading of "Parts") and E6 (Column heading of "Labor"). So, after I run a sub procedure, Sheet1 should show the following: Gear Parts,Labor,Misc Tranny Traps Door Parts, Labor I don't care if it's easier to put each column header instance in a separate column on Sheet1 (instead of values separated by commas), because I can combine them as a separate step. Also, if getting the actual column header value is a big complication, I don't mind just returning the column letters and then I can run a sub or use a formula to change column letters to their respective header names as a separate step also. Can anyone help me figure out how to do this? Any help is greatly appreciated, and thanks for reading. |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Checking sheet for values and capturing column name
Direct hit again, Mr. Ogilvy.
This one is going to take serious study. From the code, I can usually figure out what does what and how to use it in the future, but a lot of lines in this one are things I'm not familiar with. Is there a place that walks newbies through how to use common vba lines, like what to write to cycle through all cells, certain ranges or selections, etc.? I really stink with the "With" things and "Do Until" and "Loop." I usually record macros and then go through and replace/alter stuff and delete unnecessary stuff, but I've never grasped the above types of things, because you can't really record it. Thanks again for your help, it is truly appreciated. "Tom Ogilvy" wrote in message ... Glad you find some of my stuff useful: Option Explicit Sub GetcolumnHeaders() Dim fAddr As String Dim sStr As String, s As String Dim rng As Range Dim rng2 As Range Dim cell As Range Dim cell1 As Range Dim cell2 As Range Dim nodupes As Collection Dim itm As Variant With Worksheets("Sheet1") Set rng = .Range(.Range("A2"), _ .Range("A2").End(xlDown)) End With For Each cell In rng Set rng2 = Nothing sStr = cell.Value With Worksheets("sheet2").Cells Set rng = .Find( _ What:=sStr, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not rng Is Nothing Then fAddr = rng.Address Do If rng2 Is Nothing Then Set rng2 = rng Else Set rng2 = Application.Union(rng2, rng) End If Set rng = .FindNext(rng) Loop While rng.Address < fAddr End If cell.Offset(0, 1).ClearContents s = "" If Not rng2 Is Nothing Then Set nodupes = New Collection For Each cell1 In rng2 Set cell2 = cell1.Parent.Cells(1, cell1.Column) On Error Resume Next nodupes.Add cell2.Value, cell2.Text On Error GoTo 0 Next ' ' Optional Sort code would go here ' For Each itm In nodupes s = s & itm & "," Next cell.Offset(0, 1).Value = Left(s, Len(s) - 1) End If End With Next End Sub should do it. If you want them sorted, see John Walkenbach's site http://www.j-walk.com/ss/excel/tips/tip47.htm see the sort collection part of the code. -- Regards, Tom Ogilvy "Complete Newb" wrote in message ... Tom: That was amazing; totally worked. Tom, you continue to carry a significant amount of us newbies. I still have several examples you provided on the newsgroups a long time ago (not trying to say you're old or anything), that I continue to use as the basis for my own modifications when I need to execute similar, but different, tasks. I have one questions about the results of this; I had not anticipated that many of these values would actually be in ONE column several times. Is there a way to either: - Tell the VBA in your example to ignore multiple identical instances or - (and this one would probably be easier) Delete duplicate values in each cell's comma-delimited list in the results sheet (ie. "Labor,Labor,Labor,Parts" would become "Labor,Parts") Again, thank you very much. "Tom Ogilvy" wrote in message ... Option Explicit Sub GetcolumnHeaders() Dim fAddr As String Dim sStr As String, s As String Dim rng As Range Dim rng2 As Range Dim cell As Range Dim cell1 As Range With Worksheets("Sheet1") Set rng = .Range(.Range("A2"), _ .Range("A2").End(xlDown)) End With For Each cell In rng Set rng2 = Nothing sStr = cell.Value With Worksheets("sheet2").Cells Set rng = .Find( _ What:=sStr, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not rng Is Nothing Then fAddr = rng.Address Do If rng2 Is Nothing Then Set rng2 = rng Else Set rng2 = Application.Union(rng2, rng) End If Set rng = .FindNext(rng) Loop While rng.Address < fAddr End If cell.Offset(0, 1).ClearContents s = "" If Not rng2 Is Nothing Then For Each cell1 In rng2 s = s & _ cell1.Parent.Cells(1, _ cell1.Column) & "," Next cell.Offset(0, 1).Value = Left(s, Len(s) - 1) End If End With Next End Sub -- Regards, Tom Ogilvy "Complete Newb" wrote: It's weird that every time I think I'm going to know how to do something, it winds up I get 1/4 or 1/2 way there and then stuck. On Sheet1 I have one column of text values (about 500) in Column A (w/ header of "Unique"). On Sheet2 there are many columns and many rows, with all kinds of values everywhere. What I need to do is: Run through Sheet2, and for every occurrence of a value in Sheet1's "Unique" column, enter the column heading(s) of the column(s) that value is in in Column 2 of Sheet1 next to that value. For instance, Sheet1's "Unique" column has: Gear Tranny Door On Sheet2: - The value "Gear" is located in A5 (Column heading of "Parts"), E114 (Column heading of "Labor"), and G55 (Column heading of "Misc"). - The value "Tranny" is in B45 (Column heading of "Traps") - The value "Door" is in A88 (Column heading of "Parts") and E6 (Column heading of "Labor"). So, after I run a sub procedure, Sheet1 should show the following: Gear Parts,Labor,Misc Tranny Traps Door Parts, Labor I don't care if it's easier to put each column header instance in a separate column on Sheet1 (instead of values separated by commas), because I can combine them as a separate step. Also, if getting the actual column header value is a big complication, I don't mind just returning the column letters and then I can run a sub or use a formula to change column letters to their respective header names as a separate step also. Can anyone help me figure out how to do this? Any help is greatly appreciated, and thanks for reading. |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Checking sheet for values and capturing column name
It is looking in sheet 1 for the word Unique to identify in which column
the list of unique words is located. For some reason it isn't finding it. I just assumed it was in column 1 of sheet1 like you said. It doesn't address the problem of multiple identical column header entries. -- Regards, Tom Ogilvy "CompleteNewb" wrote in message . .. JE: Thanks for offering that VBA. From the looks of it, this would actually address the issue with multiple identical column header entries (like if a value from Sheet1 happens to be in A5, A10, A122, etc.). However, when I try it, it just goes to the msgbox saying no unique values found, which I know can't be the case. I made sure the sheet titles are correct; do you know why the check returns the msgbox? Thanks again, your help is very much appreciated. "JE McGimpsey" wrote in message ... One way: Public Sub ListUniqueHeaders() Dim rCell As Range Dim rUnique As Range Dim rFound As Range Dim sColumnHeaders As String Dim sFirstAddress As String With Worksheets("Sheet1") Set rUnique = .Cells.Find( _ What:="Unique", _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ Lookat:=xlWhole, _ MatchCase:=False) If rUnique Is Nothing Then MsgBox "'Unique' column not found)" Exit Sub Else Set rUnique = .Range(rUnique.Offset(1, 0), _ .Cells(.Rows.Count, rUnique.Column).End(xlUp)) If rUnique.Cells.Count = 1 Then MsgBox "No values in 'Unique' column" Exit Sub End If End If End With With Sheets("Sheet2") For Each rCell In rUnique Set rFound = .Cells.Find( _ What:=rCell.Text, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ Lookat:=xlPart, _ MatchCase:=False) If Not rFound Is Nothing Then sFirstAddress = rFound.Address Do sColumnHeaders = sColumnHeaders & "," & _ rFound.EntireColumn.Cells(1).Text Set rFound = .Cells.FindNext(After:=rFound) Loop Until rFound.Address = sFirstAddress rCell.Offset(0, 1).Value = Mid(sColumnHeaders, 2) sColumnHeaders = vbNullString Set rFound = Nothing End If Next rCell End With End Sub In article , "Complete Newb" wrote: It's weird that every time I think I'm going to know how to do something, it winds up I get 1/4 or 1/2 way there and then stuck. On Sheet1 I have one column of text values (about 500) in Column A (w/ header of "Unique"). On Sheet2 there are many columns and many rows, with all kinds of values everywhere. What I need to do is: Run through Sheet2, and for every occurrence of a value in Sheet1's "Unique" column, enter the column heading(s) of the column(s) that value is in in Column 2 of Sheet1 next to that value. For instance, Sheet1's "Unique" column has: Gear Tranny Door On Sheet2: - The value "Gear" is located in A5 (Column heading of "Parts"), E114 (Column heading of "Labor"), and G55 (Column heading of "Misc"). - The value "Tranny" is in B45 (Column heading of "Traps") - The value "Door" is in A88 (Column heading of "Parts") and E6 (Column heading of "Labor"). So, after I run a sub procedure, Sheet1 should show the following: Gear Parts,Labor,Misc Tranny Traps Door Parts, Labor I don't care if it's easier to put each column header instance in a separate column on Sheet1 (instead of values separated by commas), because I can combine them as a separate step. Also, if getting the actual column header value is a big complication, I don't mind just returning the column letters and then I can run a sub or use a formula to change column letters to their respective header names as a separate step also. Can anyone help me figure out how to do this? Any help is greatly appreciated, and thanks for reading. |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Checking sheet for values and capturing column name
Get a book like Excel [version] VBA Step by Step by Read Jacobson or
John Walkenbach's power programming book (for whatever version). http://www.j-walk.com/ss/excel link on the left to his books. -- Regards, Tom Ogilvy "CompleteNewb" wrote in message . .. Direct hit again, Mr. Ogilvy. This one is going to take serious study. From the code, I can usually figure out what does what and how to use it in the future, but a lot of lines in this one are things I'm not familiar with. Is there a place that walks newbies through how to use common vba lines, like what to write to cycle through all cells, certain ranges or selections, etc.? I really stink with the "With" things and "Do Until" and "Loop." I usually record macros and then go through and replace/alter stuff and delete unnecessary stuff, but I've never grasped the above types of things, because you can't really record it. Thanks again for your help, it is truly appreciated. "Tom Ogilvy" wrote in message ... Glad you find some of my stuff useful: Option Explicit Sub GetcolumnHeaders() Dim fAddr As String Dim sStr As String, s As String Dim rng As Range Dim rng2 As Range Dim cell As Range Dim cell1 As Range Dim cell2 As Range Dim nodupes As Collection Dim itm As Variant With Worksheets("Sheet1") Set rng = .Range(.Range("A2"), _ .Range("A2").End(xlDown)) End With For Each cell In rng Set rng2 = Nothing sStr = cell.Value With Worksheets("sheet2").Cells Set rng = .Find( _ What:=sStr, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not rng Is Nothing Then fAddr = rng.Address Do If rng2 Is Nothing Then Set rng2 = rng Else Set rng2 = Application.Union(rng2, rng) End If Set rng = .FindNext(rng) Loop While rng.Address < fAddr End If cell.Offset(0, 1).ClearContents s = "" If Not rng2 Is Nothing Then Set nodupes = New Collection For Each cell1 In rng2 Set cell2 = cell1.Parent.Cells(1, cell1.Column) On Error Resume Next nodupes.Add cell2.Value, cell2.Text On Error GoTo 0 Next ' ' Optional Sort code would go here ' For Each itm In nodupes s = s & itm & "," Next cell.Offset(0, 1).Value = Left(s, Len(s) - 1) End If End With Next End Sub should do it. If you want them sorted, see John Walkenbach's site http://www.j-walk.com/ss/excel/tips/tip47.htm see the sort collection part of the code. -- Regards, Tom Ogilvy "Complete Newb" wrote in message ... Tom: That was amazing; totally worked. Tom, you continue to carry a significant amount of us newbies. I still have several examples you provided on the newsgroups a long time ago (not trying to say you're old or anything), that I continue to use as the basis for my own modifications when I need to execute similar, but different, tasks. I have one questions about the results of this; I had not anticipated that many of these values would actually be in ONE column several times. Is there a way to either: - Tell the VBA in your example to ignore multiple identical instances or - (and this one would probably be easier) Delete duplicate values in each cell's comma-delimited list in the results sheet (ie. "Labor,Labor,Labor,Parts" would become "Labor,Parts") Again, thank you very much. "Tom Ogilvy" wrote in message ... Option Explicit Sub GetcolumnHeaders() Dim fAddr As String Dim sStr As String, s As String Dim rng As Range Dim rng2 As Range Dim cell As Range Dim cell1 As Range With Worksheets("Sheet1") Set rng = .Range(.Range("A2"), _ .Range("A2").End(xlDown)) End With For Each cell In rng Set rng2 = Nothing sStr = cell.Value With Worksheets("sheet2").Cells Set rng = .Find( _ What:=sStr, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not rng Is Nothing Then fAddr = rng.Address Do If rng2 Is Nothing Then Set rng2 = rng Else Set rng2 = Application.Union(rng2, rng) End If Set rng = .FindNext(rng) Loop While rng.Address < fAddr End If cell.Offset(0, 1).ClearContents s = "" If Not rng2 Is Nothing Then For Each cell1 In rng2 s = s & _ cell1.Parent.Cells(1, _ cell1.Column) & "," Next cell.Offset(0, 1).Value = Left(s, Len(s) - 1) End If End With Next End Sub -- Regards, Tom Ogilvy "Complete Newb" wrote: It's weird that every time I think I'm going to know how to do something, it winds up I get 1/4 or 1/2 way there and then stuck. On Sheet1 I have one column of text values (about 500) in Column A (w/ header of "Unique"). On Sheet2 there are many columns and many rows, with all kinds of values everywhere. What I need to do is: Run through Sheet2, and for every occurrence of a value in Sheet1's "Unique" column, enter the column heading(s) of the column(s) that value is in in Column 2 of Sheet1 next to that value. For instance, Sheet1's "Unique" column has: Gear Tranny Door On Sheet2: - The value "Gear" is located in A5 (Column heading of "Parts"), E114 (Column heading of "Labor"), and G55 (Column heading of "Misc"). - The value "Tranny" is in B45 (Column heading of "Traps") - The value "Door" is in A88 (Column heading of "Parts") and E6 (Column heading of "Labor"). So, after I run a sub procedure, Sheet1 should show the following: Gear Parts,Labor,Misc Tranny Traps Door Parts, Labor I don't care if it's easier to put each column header instance in a separate column on Sheet1 (instead of values separated by commas), because I can combine them as a separate step. Also, if getting the actual column header value is a big complication, I don't mind just returning the column letters and then I can run a sub or use a formula to change column letters to their respective header names as a separate step also. Can anyone help me figure out how to do this? Any help is greatly appreciated, and thanks for reading. |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Checking sheet for values and capturing column name
I didn't see that you always have the unique items were always in column
A, so the first part of the macro looks for the title 'Unique' in the first sheet. To eliminate duplicates, it would be easiest to loop through the populated columns. In article , "CompleteNewb" wrote: Thanks for offering that VBA. From the looks of it, this would actually address the issue with multiple identical column header entries (like if a value from Sheet1 happens to be in A5, A10, A122, etc.). However, when I try it, it just goes to the msgbox saying no unique values found, which I know can't be the case. I made sure the sheet titles are correct; do you know why the check returns the msgbox? Thanks again, your help is very much appreciated. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Checking a column of values against another one | Charts and Charting in Excel | |||
Capturing Maximum and Minimum values | Excel Programming | |||
Need hlp capturing a certain pattrern from a column | Excel Programming | |||
Capturing Sheet Events | Excel Programming | |||
How do I search thr'o column and put unique values in differnt sheet and sum corresponding values in | Excel Programming |