PDA

View Full Version : [SOLVED] Function tweak



jacksonworld
08-04-2005, 11:30 PM
Hi, I have a lookup function that needs a small tweak of which once again, I have unsuccessfully attempted to perform :banghead: .

This function gives me the results in one cell, comma separated. I would like the results to span across a row. For example, if I entered my formaula in cell F1, the first result match would in F1, the second match in G1, and so on. I believe the answer is easy. Just not for me. :)

Can anyone assist?


Option Explicit

Function mvlookup(lookupValue, tableArray As Range, colIndexNum As Long, _
Optional NotUsed As Variant) As Variant

Dim initTable As Range
Dim myRowMatch As Variant
Dim myRes() As Variant
Dim myStr As String
Dim initTableCols As Long
Dim i As Long
Dim ubound_myRes As Long
Set initTable = Nothing
On Error Resume Next
Set initTable = Intersect(tableArray, _
tableArray.Parent.UsedRange.EntireRow)
On Error GoTo 0
If initTable Is Nothing Then
mvlookup = CVErr(xlErrRef)
Exit Function
End If
initTableCols = initTable.Columns.Count
i = 0
Do
myRowMatch = Application.Match(lookupValue, initTable.Columns(1), 0)
If IsError(myRowMatch) Then
Exit Do
Else
i = i + 1
ReDim Preserve myRes(1 To i)
myRes(i) _
= initTable(1).Offset(myRowMatch - 1, colIndexNum - 1).Text
If initTable.Rows.Count <= myRowMatch Then
Exit Do
End If
On Error Resume Next
Set initTable = initTable.Offset(myRowMatch, 0) _
.Resize(initTable.Rows.Count - myRowMatch, _
initTableCols)
On Error GoTo 0
If initTable Is Nothing Then
Exit Do
End If
End If
Loop
If i = 0 Then
mvlookup = CVErr(xlErrNA)
Exit Function
End If
myStr = ""
For i = LBound(myRes) To UBound(myRes)
myStr = myStr & ", " & myRes(i)
Next i
mvlookup = Mid(myStr, 3)
End Function

Justinlabenne
08-05-2005, 08:09 PM
You could use it in a sub to process it:



Sub ProcessYourFunc()
Dim vLook
Dim TableRng As Range
Dim Col As Long
Set vLook = Range("C1")
Set TableRng = Range("A1:B10")
Col = 2
Dim vArr As Variant
vArr = mvlookup(vLook, TableRng, Col)
Dim vSplit As Variant
vSplit = Split(vArr, ",")
Dim i As Long
For i = LBound(vSplit) To UBound(vSplit)
Cells(1, i + 6).Value = vSplit(i)
Next i
Set vLook = Nothing
Set TableRng = Nothing
End Sub



I made alot of assumptions about where you get your lookupValue and what the actual TableRange range is, but it can maybe get you started.

jacksonworld
08-05-2005, 11:14 PM
Thanks Justin, but I could not get that working.

Anyhow, I am happy with a function, rather than a sub. I just want that function to display results in a number of cells, and not just one.

Any other ideas?

jindon
08-06-2005, 01:00 AM
Hi
not sure if it works
use like

=mvlookup(value,tblarray,colIndex,Column(a1),....)
then copy to the right



Function mvlookup(lookupValue, tableArray As Range, colIndexNum As Long, _
aryIndex As Long, Optional NotUsed As Variant) As Variant
Dim initTable As Range
Dim myRowMatch As Variant
Dim myRes() As Variant
Dim initTableCols As Long
Dim i As Long
Dim ubound_myRes As Long
Set initTable = Nothing
On Error Resume Next
Set initTable = Intersect(tableArray, tableArray.Parent.UsedRange.EntireRow)
On Error GoTo 0
If initTable Is Nothing Then
mvlookup = CVErr(xlErrRef)
Exit Function
End If
initTableCols = initTable.Columns.Count
i = 0
Do
myRowMatch = Application.Match(lookupValue, initTable.Columns(1), 0)
If IsError(myRowMatch) Then
Exit Do
Else
i = i + 1
ReDim Preserve myRes(1 To i)
myRes(i) _
= initTable(1).Offset(myRowMatch - 1, colIndexNum - 1).Text
If initTable.Rows.Count <= myRowMatch Then
Exit Do
End If
On Error Resume Next
Set initTable = initTable.Offset(myRowMatch, 0) _
.Resize(initTable.Rows.Count - myRowMatch, _
initTableCols)
On Error GoTo 0
If initTable Is Nothing Then
Exit Do
End If
End If
Loop
If i = 0 Then
mvlookup = CVErr(xlErrNA)
Exit Function
End If
mvlookup = myRes(aryIndex - 1)
End Function

Justinlabenne
08-06-2005, 05:36 AM
Jindon's got you on the right track if you want to use formulas across your columns.

What you want to do with just a function is not easy (not going to say it's impossible, but I have my doubts) How would the function know to put the results into the other cells? The formula is in Cell F1, how would cells G1, H1, etc... obtain the results from each "after comma" value returned by F1?

Jindons revision may work for you, but if you can attach a copy of how your file is layed out, where you get LookupValue from, etc.. it is quite possible to modify my sub to do what your asking wthout needing extrac formulas, but whatever works best for you...

Norie
08-06-2005, 06:48 AM
Functions are not meant to alter the contents of a worksheet, they are meant to return values.

You should use a Sub as suggested by Justin.

Bob Phillips
08-06-2005, 07:15 AM
Functions are not meant to alter the contents of a worksheet, they are meant to return values.

You should use a Sub as suggested by Justin.

Doesn't seem to have a lot to do with the question :devil:

Jacksonworld,

I have been superficially following this post, so I may have over-simplified it in my mind, but I think you were almost there. All you need is a small tweak to your code, see below, and then select the result cells, say F1:L1, then type the formula in the formula bar,
=MVLOOKUP(val,rng,colindex), and arry enter it, so in other words it is a cell formula spanning an array rather than an array formula spanning a single cell



Option Explicit

Function mvlookup(lookupValue, tableArray As Range, colIndexNum As Long, _
Optional NotUsed As Variant) As Variant
Dim initTable As Range
Dim myRowMatch As Variant
Dim myRes() As Variant
Dim initTableCols As Long
Dim i As Long
Dim ubound_myRes As Long
Set initTable = Nothing
On Error Resume Next
Set initTable = Intersect(tableArray, _
tableArray.Parent.UsedRange.EntireRow)
On Error GoTo 0
If initTable Is Nothing Then
mvlookup = CVErr(xlErrRef)
Exit Function
End If
initTableCols = initTable.Columns.Count
i = 0
Do
myRowMatch = Application.Match(lookupValue, initTable.Columns(1), 0)
If IsError(myRowMatch) Then
Exit Do
Else
i = i + 1
ReDim Preserve myRes(1 To i)
myRes(i) _
= initTable(1).Offset(myRowMatch - 1, colIndexNum - 1).Text
If initTable.Rows.Count <= myRowMatch Then
Exit Do
End If
On Error Resume Next
Set initTable = initTable.Offset(myRowMatch, 0) _
.Resize(initTable.Rows.Count - myRowMatch, _
initTableCols)
On Error GoTo 0
If initTable Is Nothing Then
Exit Do
End If
End If
Loop
If i = 0 Then
mvlookup = CVErr(xlErrNA)
Exit Function
End If
mvlookup = myRes
End Function

Justinlabenne
08-06-2005, 09:36 AM
Very nice xld, that was an idea I had after re-reading a couple of J-Walks books, but couldn't get it to turn out..

:bow:

Bob Phillips
08-06-2005, 10:03 AM
Very nice xld, that was an idea I had after re-reading a couple of J-Walks books, but couldn't get it to turn out..

:bow:

Thanks Justin. There is one problem (ette) with it. I'll wait to see if Jacksonworld experineces it before I offer some mitigating solutions :devil:

jacksonworld
08-06-2005, 08:38 PM
It worked! :thumb

Thank you very much, xld.

Admittedly, I am away from my regular computer, and have not thoroughly tested on the spreadsheet I have in mind. But so far, so good.

What was this small problem you speak of?

Bob Phillips
08-07-2005, 03:03 AM
It worked! :thumb

Thank you very much, xld.

Admittedly, I am away from my regular computer, and have not thoroughly tested on the spreadsheet I have in mind. But so far, so good.

What was this small problem you speak of?

You're welcome. I should really apologise for not posting earlier, I thought this was what you wanted right from the start, but I couldn't be bothered to get deep into your code :whistle:), and others seem to take it another way, which made me doubt until I saw the response by Norie.

I won't mention the problems yet, wait until you test on your regular machine and see if you find it and how you try to deal with it (better to learn than to be told). If you don't get any problems, post back and I will tell you.

.

jacksonworld
08-07-2005, 04:25 PM
I have experienced one problem. If there is only 1 match, and I select multiple cells, it displays that match in each of those cells.

Is that the problem that you had in mind?

jacksonworld
08-07-2005, 04:38 PM
Also, where there is no match, it gives me #N/A despite me using the formula {=IF(ISNA(MVLOOKUP(val,rng,colindex)),"",(MVLOOKUP(val,rng,colindex))}

Justinlabenne
08-07-2005, 05:24 PM
When I tested it out that is what I figured might be an issue. Depends on how many results you get back (0-?) so how many columns across would you need. It would differ every time most likely.

I am sure xld has something tricky in his bag to take care of this, and I have no idea what it could be honestly, but some alternatives if your looking for all the matches based on a lookupValue may be to switch udf's to something like this (http://www.vbaexpress.com/kb/getarticle.php?kb_id=8) where you could have the formulas copied across a lot of columns with incrementing "nth_values" to return the different matches. And for non matches it just returns "NotFound" or you can replace "NotFound" with an empty string in the function.

Possible alternative, but your pretty close to a solution, and xld is hinting that he has the solution (and I am not doubting him)

Have to wait and see....:read2:

Bob Phillips
08-08-2005, 02:40 AM
The #N/A is the problem that I was thinking of, and as you say the ISNA does not handle this, because the array will return a TRUE is there is at least one match negating the ISNA.

The big problem with this is that there is no way (at least none that I know of) whereby you can identify the number of cells in that array (remember, it will recalculate at any point, which means that you cannot rely on using Selection).

My best solution was to dimension an array at the size of the lookup range, and fill it with zero or blank if it is not already filled. This will still give a #N/A if you select more cells than the lookup range rows, but can't see a solution to that I am afraid.

I don't have the code on this machine, so I will post it a bit later.

.

Bob Phillips
08-08-2005, 02:51 AM
Here is the code.

BTW This also overcomes the first problem that Jacksonworld mentioned, although I haven't quite worked it through as to why yet :)


Option Explicit

Function mvlookup(lookupValue, tableArray As Range, colIndexNum As Long, _
Optional NotUsed As Variant) As Variant
Dim initTable As Range
Dim myRowMatch As Variant
Dim myRes() As Variant
Dim initTableCols As Long
Dim i As Long
Dim ubound_myRes As Long
Set initTable = Nothing
On Error Resume Next
Set initTable = Intersect(tableArray, _
tableArray.Parent.UsedRange.EntireRow)
On Error GoTo 0
If initTable Is Nothing Then
mvlookup = CVErr(xlErrRef)
Exit Function
End If
initTableCols = initTable.Columns.Count
ReDim Preserve myRes(1 To tableArray.Rows.Count)
i = 0
Do
myRowMatch = Application.Match(lookupValue, initTable.Columns(1), 0)
If IsError(myRowMatch) Then
Exit Do
Else
i = i + 1
myRes(i) _
= initTable(1).Offset(myRowMatch - 1, colIndexNum - 1).Text
If initTable.Rows.Count <= myRowMatch Then
Exit Do
End If
On Error Resume Next
Set initTable = initTable.Offset(myRowMatch, 0) _
.Resize(initTable.Rows.Count - myRowMatch, _
initTableCols)
On Error GoTo 0
If initTable Is Nothing Then
Exit Do
End If
End If
Loop
If i = 0 Then
mvlookup = CVErr(xlErrNA)
Exit Function
ElseIf i < UBound(myRes) Then
For i = i + 1 To UBound(myRes)
myRes(i) = ""
Next i
End If
mvlookup = myRes
End Function

jacksonworld
08-08-2005, 03:59 AM
xld, you are genius!

I am trying to understand how you did it, but for the moment, I don't care. :)

Fantastic work. Thank you so much. :bow:

excelliot
08-09-2005, 04:11 AM
Hi all

Is it possible to produce same result in different coloumns instead of rows

Bob Phillips
08-09-2005, 04:31 AM
Hi all

Is it possible to produce same result in different coloumns instead of rows

This does it vertically or horizontally.

Vertically


=MVLOOKUP(val,rng,colindex,TRUE)

Horizontally


=MVLOOKUP(val,rng,colindex,FALSE)
or

=MVLOOKUP(val,rng,colindex)



Option Explicit

Function mvlookup(lookupValue, tableArray As Range, colIndexNum As Long, _
Optional Vertical As Boolean = False, _
Optional NotUsed As Variant) As Variant
Dim initTable As Range
Dim myRowMatch As Variant
Dim myRes() As Variant
Dim initTableCols As Long
Dim i As Long
Dim ubound_myRes As Long
Set initTable = Nothing
On Error Resume Next
Set initTable = Intersect(tableArray, _
tableArray.Parent.UsedRange.EntireRow)
On Error GoTo 0
If initTable Is Nothing Then
mvlookup = CVErr(xlErrRef)
Exit Function
End If
initTableCols = initTable.Columns.Count
ReDim myRes(1 To tableArray.Rows.Count)
i = 0
Do
myRowMatch = Application.Match(lookupValue, initTable.Columns(1), 0)
If IsError(myRowMatch) Then
Exit Do
Else
i = i + 1
myRes(i) _
= initTable(1).Offset(myRowMatch - 1, colIndexNum - 1).Text
If initTable.Rows.Count <= myRowMatch Then
Exit Do
End If
On Error Resume Next
Set initTable = initTable.Offset(myRowMatch, 0) _
.Resize(initTable.Rows.Count - myRowMatch, _
initTableCols)
On Error GoTo 0
If initTable Is Nothing Then
Exit Do
End If
End If
Loop
If i = 0 Then
mvlookup = CVErr(xlErrNA)
Exit Function
ElseIf i < UBound(myRes) Then
For i = i + 1 To UBound(myRes)
myRes(i) = ""
Next i
End If
If Vertical Then
mvlookup = Application.Transpose(myRes)
Else
mvlookup = myRes
End If
End Function

excelliot
08-09-2005, 04:54 AM
Gr8 work xld:bow:

where were u b4 dear

Any resources to learn VBA for newbie like us

Bob Phillips
08-09-2005, 07:05 AM
Gr8 work xld:bow:

Thank you.


where were u b4

Before when?


dear

Strange phrase.


Any resources to learn VBA for newbie like us

Start here http://www.mvps.org/dmcritchie/excel/getstarted.htm

johnske
08-09-2005, 01:53 PM
...Any resources to learn VBA for newbie like us have a look here (1st lesson is free) > http://www.vbaexpress.com/training.htm