Function needed to pull in cell values

[Jen_T]

Is there a function I could create in Excel 2007 VBA module that would look
a range of cells and pull in the values.
In columns A - F, I have column headers,
Column A - Hand Tools
Column B - Power Tools
Column C - Lawn and Garden Tools
Column D - Misc Tools
Column E - Yard Accessories
Column F - Misc
Each will have values of either a "Y" or"N", starting in row 2
In Column G, header is titled "Equip. Sold".
I have a macro that pulls in the column header if ="Y" in columns A - F.
However I am looking to achieve something a little different. I need to
indicate "Tools" in cell G2 to final row, if cell value = "Y" in any of the
columns A through D, than pull in remaining columns headers, E through F if
cell value ="Y".

Example:
If column A(Hand Tools) ="Y"
column B (Power Tools) ="N'
column C (Lawn and Garden Tools)="Y"
column D (Misc Tools) ="Y"
column E ( Yard Accessories) ="N"
column F ( Misc) ="Y".
Than cell G2 -= Tool, Yard Accessories, Misc

Here is my current module I am using:

Function Mstring(myrange)
Set myEquip = Range("A1:F1")
mycount = myrange.Count
myflag = True
For j = 1 To mycount
If myrange(j) = "Y" Then
If myflag Then
Mstring = Mstring & myEquip(j)
myflag = False
Else
Mstring = Mstring & "," & myEquip(j)
End If
End If
Next j
End Function

Thank you for your suggestions in advance. I would include an attachment but
not sure if possible in this discussion group, if so please advise how to
include attachments. Thank you

 

[Jacob Skaria]

Try this UDF (User Defined function). From workbook launch VBE using Alt+F11.
From menu Insert a Module and paste the below function.Close and get back to
workbook and try the below formula.

In cell G2 you can use the formula
=mstring(dataRange,headerRange)
=mstring(A2:F2,$A$1:$F$1)

Function Mstring(myRange As Range, myHeader As Range) As String
For Each cell In myRange.Cells
If UCase(cell.Text) = "Y" Then
If cell.Column <= 4 Then
Mstring = "Tool"
Else
Mstring = Mstring & " , " & myHeader(cell.Column)
End If
End If
Next
End Function

If this post helps click Yes

 

[Jen_T]

Jacob,

Thank you for the code. I am receiving a "Variable not defined error" on
"cell" ?

 

[Jacob Skaria]

Missed to declare the variable. Try the below

Function Mstring(myRange As Range, myHeader As Range) As String
Dim cell As Range
For Each cell In myRange.Cells
If UCase(cell.Text) = "Y" Then
If cell.Column <= 4 Then
Mstring = "Tool"
Else
Mstring = Mstring & " , " & myHeader(cell.Column)
End If
End If
Next
End Function


If this post helps click Yes

 

[Jen_T]

This works great, thank you. One question if there is no"Y" in wither of the
first four columns, is there a way to not have the ",", inserted.

I end up with something like this currently
, Yard Accessories, Misc

Like to see

Yard Accessories, Misc

 

[Jacob Skaria]

Sure you can; I should have handled that ..

Function Mstring(myRange As Range, myHeader As Range) As String
Dim cell As Range
For Each cell In myRange.Cells
If UCase(cell.Text) = "Y" Then
If cell.Column <= 4 Then
Mstring = " , Tool"
Else
Mstring = Mstring & " , " & myHeader(cell.Column)
End If
End If
Next
Mstring = Mid(Mstring, 4)
End Function

If this post helps click Yes

 

[Jen_T]

Hi Jacob, thank you for the assistance. To add to this, if I was to add this
to another worksheet, and the columns names were different but I wanted to
accompolish the same what would my steps be ?
For instance:

COlumn Headers in another sheet I have is:

A, B, C, D, E, F, G, H

And if B, C, D, E, or F has a "Y" value I would like it to indicate "Priority"


This is alittle different where the column headers may not contain text like
the previous, "tools".

 

[Jacob Skaria]

Try the below and feedback.

Function Mstring(myRange As Range) As String
Dim cell As Range
For Each cell In myRange.Cells
If UCase(cell.Text) = "Y" Then
Select Case cell.Column
Case 2 To 6
Mstring = "Priority"
End Select
End If
Next
End Function

If this post helps click Yes

 

[Jen_T]

Well I would still need the other column headers to pull in if equal to "Y",
so columns 2 to 4 if "Y" would indicate "Priority" and the others if "Y"
need to pull in
Ex: A2 (Y) B2 (Y) C2 (N) D2 (Y) E2 (Y) F2 (Y)

G2 = A, Priority, E, F

 

[Jacob Skaria]

Try the below

The second range is optional If not specified it will return the column
header...
=Mstring(A5:H5)

'If specified it will return the header text
=Mstring(A5:H5,A1:H1)

Function Mstring(myRange As Range, Optional myHeader As Range) As String
Dim cell As Range, blnPass As Boolean
For Each cell In myRange.Cells
If UCase(cell.Text) = "Y" Then
Select Case cell.Column
Case 2 To 4
If Not blnPass Then _
Mstring = Mstring & ", " & "Priority": blnPass = True
Case Else
If myHeader Is Nothing Then
Mstring = Mstring & ", " & Replace(Cells(1, _
cell.Column).Address(False, False), "1", "")
Else
Mstring = Mstring & ", " & myHeader(1, cell.Column)
End If
End Select
End If
Next
Mstring = Mid(Mstring, 3)
End Function

If this post helps click Yes