Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VBA if value found in cell, return column header name 1

Status
Not open for further replies.

SBuzzT

Programmer
Aug 24, 2005
86
CA
Hi excel gods :)

I am searching for an value in column C of a worksheet. If the exact value is found (it will be a unique value on each row), I need to check the whole row and return the column header name for each cell which has the value "Y". For example, if I searched for and located 123 in C5, and and D5 and G5 contained Y, the result would be D5, G5.

Note: I'm using column letters in the example, but the column headers will actually be names which I need to return comma separated.

I have the search part working fine and I am returning the values for each of the cells in the row, but I'm stuck on how to get each of the column header names.

Can someone point me in the right direction?

 
hi

What code to do you currently have? Please post.

What happens when you execute your code?

You mentioned returning "column header name" but your written spec says you want data from the row in which the search value is found. Can you please clarify?

Please answer each and every one of these questions fully. We need infomation and clarity




Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
I have the search part working fine" so I assume you can get the "D5 and G5 contained Y". Then simply check the value of D[blue]1[/blue] and G[blue]1[/blue] - assuming your header is row 1.

Have fun.

---- Andy
 

Maybe this will work for you
Code:
Function test()
    Dim rFound As Range, c As Range, vVal
    
    vVal = InputBox("Enter search value")
    
    If vVal <> "" Then
    
        With Sheet2
            Set rFound = .Columns(3).Find(vVal)
            
            If Not rFound Is Nothing Then
                For Each c In Intersect(rFound.EntireRow, .UsedRange)
                    If c.Value = "y" Then
                        test = test & Intersect(c.EntireColumn, .UsedRange.Cells(1, 1).EntireRow) & ","
                    End If
                Next
                If Len(test) > 0 Then
                    test = Left(test, Len(test) - 1)
                End If
            Else
                test = ""
            End If
        End With
    End If
End Function

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Hi Skip. Here's the code. It's similar code that I've used in the past (and I am re-purposing) so I will likely have to modify it further, but it's a starting point for me.

Code:
Sub ExCheck()

Dim rng As Range, Cel, ms As Worksheet, ws As Worksheet, k, NR&

Set ms = Sheets("Search")

Application.ScreenUpdating = 0

     With ms
       Cel = .Range("C3")
     End With
     
     For Each ws In ThisWorkbook.Worksheets

        If ws.Name <> ms.Name Then
            If ws.Name = "Sheet1Name" Then
            
                With ws.Range("C:C") 'id column
    
                        If Len(Cel) Then
                              
                                Set rng = .Find(Cel, LookIn:=xlValues, LookAt:=xlWhole)
                                                                                                                                                                  
                                   If Not rng Is Nothing Then
                                        rng.Offset(, 1).Copy
                                        ms.Range("C6").PasteSpecial xlValues 'names
                                        rng.Copy
                                        ms.Range("D6").PasteSpecial xlValues 'ids
                                        Range("C3").Select
                                        Range("C3").ClearContents
                                        'need column headers to appear in D3
                                   End If
                        End If
         
                End With
                
            End If
            
        End If
 Next
 
Application.CutCopyMode = 0
Set ms = Nothing
Set rng = Nothing
Application.ScreenUpdating = True

End Sub
 
Sorry... Didn't see your more recent post. I'll have to try and incorporate that somehow
 
well what happens whjen you execute this code?

Where do you need help?

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 


So you want the result string in D3?

How about using Conditional Format to highlight the heading names containing the y values?

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
When I execute my code and the search finds the search value:
it returns the value from column C (the search value) into D3 (of the Search worksheet)
it returns the value from column D of the same row into C3 (of the Search worksheet)

I can easily return the Y's that may appear in any of the other cells in that same row (with a bit more code), but what I need are the headers, which are all different names to appear in E3 of the Search worksheet.
 

To answer your item, just intersect the entire column range where the y occurs, with the entier row range of the heading to get the heading value.

What about a conditional format of the heading names where y appears in the same row as the search value? You never answered this question.


Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Sorry for not answering, Skip. If I understand what you're suggesting, that would mean people would be looking at the sheet with all the data. That sheet will actually be hidden and locked, so I need the results to appear on the search sheet.
 


Okay.

So did you try the Intersect() as I suggested and illustrated in the code I previously posted?

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Working on it... As I have mentioned in previous posts; I'm not VBA expert - I basically just re-purpose what I have done previously. lol
 
But you are a professional programmer. Press on!

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
lol Thanks for the encouragement. I was a webmaster (PHP, HTML, Javascript, etc.) awhile ago. VBA is newer for me, but I'm learning...
 
Yup, it takes diving in and getting yer hands dirty.

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
So, I tried a bunch of ways of doing this (I thought this was close) but I'm getting run-time error '424' Object required in my loop (For Each c In Intersect...)

I think I suck at this. lmao

Code:
            If ws.Name = "Sheet1Name" Then
            
                With ws.Range("C:C") 'id column
    
                        If Len(Cel) Then
                              
                                Set rng = .Find(Cel, LookIn:=xlValues, LookAt:=xlWhole)
                                                                                                                                                                  
                                   If Not rng Is Nothing Then
                                        rng.Offset(, 1).Copy
                                        ms.Range("C6").PasteSpecial xlValues 'names
                                        rng.Copy
                                        ms.Range("D6").PasteSpecial xlValues 'ids
                                        Range("C3").Select
                                        Range("C3").ClearContents
                                        'need column headers to appear in D3
                                        
                                            For Each c In Intersect(rng.EntireRow, UsedRange)
                                                If c.Value = "y" Then
                                                    k = k & Intersect(c.EntireColumn, .UsedRange.Cells(1, 1).EntireRow) & ","
                                                End If
                                            Next
                                        'ms.Range("E6") = Mid(k, 2)
                                   End If
                        End If
         
                End With
                
            End If
 
Still haven't got this (I know; I suck). Any clues on how to make this work?
 
I'd try this:
For Each c In Intersect(rng.EntireRow, [highlight #EDD400].[/highlight]UsedRange)

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
At least I have a new error now... lol

Gives me run time error '438'
Object doesn't support this property or method.

:(
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top