Q: search rows and returning multiple columnheaders

[Excelnovice2022]

Hello,

I am struggling to find a solution to my problem. I just doesn't get this one started by myself. below i pasted an example of a table. is it possible in vba to code the follwing:

I want to search a name of person, for example Aiden. I want to know in which column a "X" stands (in this case 8, 11, 12,13,14 and 17). I want to let the columnheaders return in a msgbox. Can anyone get my started with this code?

Thanks in advance for any form of help.

 

[igold]

Welcome to the MrExcel Forum,

Is this really a Table or is it just a range of data. If it is just a range of data, where (columns) does the data reside. If it's a Table, what is the name of the Table...

 

[Domenic]

Try . . .

    Dim arr() As Variant
    
    With Application
        arr() = .Filter(Range("B1:W1"), Evaluate(Application.Index(Range("B2:W6"), Application.Match("Aiden", Range("A2:A6"), 0), 0).Address & "=""X"""))
    End With
    
    MsgBox VBA.Join(arr, ","), vbInformation

Hope this helps!

 

[Excelnovice2022]

Welcome to the MrExcel Forum,

Is this really a Table or is it just a range of data. If it is just a range of data, where (columns) does the data reside. If it's a Table, what is the name of the Table...

HI Igold,

first of all thank you for replying. If i understand your question correctly then the answer is that it is a range of data.

 

[Excelnovice2022]

Try . . .

    Dim arr() As Variant
   
    With Application
        arr() = .Filter(Range("B1:W1"), Evaluate(Application.Index(Range("B2:W6"), Application.Match("Aiden", Range("A2:A6"), 0), 0).Address & "=""X"""))
    End With
   
    MsgBox VBA.Join(arr, ","), vbInformation

Hope this helps!

Hi,

Thank you for responding to my post. I will try it and will let it know.

 

[Excelnovice2022]

Hi Domenic

I Try the code but it returns with an error 424 on the line arr() = .filter.........

I try a couple of things but I can't figure out why this error occurs.

Any Idea's?

greetz

 

[Domenic]

It's probably because there's no match of some sort. In any case, I have re-written the code so that it contains error handling. I have assumed that the workbook running the code contains the data, and that Sheet1 contains the data. Change these references as needed. Does this help?

Option Explicit

Sub test()

    Dim sourceWorksheet As Worksheet
    Set sourceWorksheet = ThisWorkbook.Worksheets("Sheet1")
    
    Dim matchValue As String
    matchValue = "Aiden"
    
    Dim headerRange As Range
    Set headerRange = sourceWorksheet.Range("B1:W1")
    
    Dim matchRange As Range
    Set matchRange = sourceWorksheet.Range("A2:A6")
    
    Dim dataRange As Range
    Set dataRange = sourceWorksheet.Range("B2:W6")
    
    Dim returnValue As Variant
    returnValue = Application.Match(matchValue, matchRange, 0)
    
    If IsError(returnValue) Then
        MsgBox "Unable to find " & matchValue & "!", vbExclamation
        Exit Sub
    End If
    
    Dim lookupRange As Range
    Set lookupRange = Application.Index(dataRange, returnValue, 0)
    
    If Application.CountIf(lookupRange, "X") = 0 Then
        MsgBox "No X's found for " & matchValue & "!", vbExclamation
        Exit Sub
    End If
    
    Dim arr() As Variant
    arr() = Application.Filter(headerRange, sourceWorksheet.Evaluate(lookupRange.Address & "=""X"""))
    
    MsgBox VBA.Join(arr, ","), vbInformation
    
    
End Sub

 

[igold]

Given your sample data and assuming that the data starts in Cell A1, then how about something like this...

Sub GetColumns()

    Dim arr
    Dim nam As String, col As String, resp As String, i As Long, c As Long
   
    arr = Range("A1", "W" & Cells(Rows.Count, 1).End(xlUp).Row)
    resp = Application.InputBox("Please Click On the Name You Want To Search...", , , , , , , 8)
    For i = 1 To UBound(arr)
        If arr(i, 1) = resp Then
            For c = 1 To UBound(arr, 2)
                If UCase(arr(i, c)) = UCase("X") Then
                    nam = nam & ", " & arr(1, c)
                End If
            Next
        End If
    Next
    MsgBox (resp & " has x's in these columns:" & Mid(nam, 2))
   
End Sub

 

[My Aswer Is This]

In your image what column are the names in?
Looks to me like it must be column 1
So in the case of Aiden the first column with a X would be column 9
You said:
in which column a "X" stands (in
Now the column header meaning row(1) value would be 8 but this is not column 8

 

[Excelnovice2022]

It's probably because there's no match of some sort. In any case, I have re-written the code so that it contains error handling. I have assumed that the workbook running the code contains the data, and that Sheet1 contains the data. Change these references as needed. Does this help?

Option Explicit

Sub test()

    Dim sourceWorksheet As Worksheet
    Set sourceWorksheet = ThisWorkbook.Worksheets("Sheet1")
   
    Dim matchValue As String
    matchValue = "Aiden"
   
    Dim headerRange As Range
    Set headerRange = sourceWorksheet.Range("B1:W1")
   
    Dim matchRange As Range
    Set matchRange = sourceWorksheet.Range("A2:A6")
   
    Dim dataRange As Range
    Set dataRange = sourceWorksheet.Range("B2:W6")
   
    Dim returnValue As Variant
    returnValue = Application.Match(matchValue, matchRange, 0)
   
    If IsError(returnValue) Then
        MsgBox "Unable to find " & matchValue & "!", vbExclamation
        Exit Sub
    End If
   
    Dim lookupRange As Range
    Set lookupRange = Application.Index(dataRange, returnValue, 0)
   
    If Application.CountIf(lookupRange, "X") = 0 Then
        MsgBox "No X's found for " & matchValue & "!", vbExclamation
        Exit Sub
    End If
   
    Dim arr() As Variant
    arr() = Application.Filter(headerRange, sourceWorksheet.Evaluate(lookupRange.Address & "=""X"""))
   
    MsgBox VBA.Join(arr, ","), vbInformation
   
   
End Sub

Hi,

I had a go with this code and it works. Thank you very much!!!!!!!!!!!!

grzt