View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default 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.