Currently the function below returns values and I have the seperated by
carrage return, however i wan to have all the values returned seperated into
new rows. Is there a way to get the data back seperated into new rows using
a subroutine?



Function MLookup(LookupRng As Range, OffsetVal As Integer, LookupVal As Range)
Dim r As Range

For Each r In LookupRng

If r.Value = LookupVal.Value Then
If Len(MLookup) = 0 Then
MLookup = r.Offset(0, OffsetVal - 1).Value
Else

MLookup = MLookup & vbCrLf & r.Offset(0, OffsetVal - 1).Value
End If
End If
Next r
End Function

Is this a function that you use in a cell in a worksheet?

If yes, then your function can't insert rows (that's what you meant by new rows,
right?).

But if you already inserted all the rows, you could use a function that returned
an array--but you'll have to use an multicell array formula for this.

This code for this function has a few minor validity checks. You have to use a
single range as the lookuprng. You have to pass it the entire range (just like
=vlookup() and that offsetval column has to be within that range.

If you don't include all the range in your function call, then excel won't know
when to recalculate. So this works like the =vlookup() function. Your key
column has to be the leftmost column in the range. (You could add another parm
that specifies that key column if you really needed to--but passing two ranges
(like =index(match()) would be simpler.

Anyway...

This is what the function would look like in a worksheet cell:
=mlookup(sheet2!A1:D20,4,x9)

And you have to select as many rows (or columns) as you think you need. If
you're use too few, you'll get an error. If you use too many, the function will
pad those additional cells with blanks.

So you would select (say) A1:A10 (or A1:J1 for a single row) and type the
formula:
=mlookup(A1:D20,1,$A$1)

This is an array formula. Hit ctrl-shift-enter instead of enter. If you do it
correctly, excel will wrap curly brackets {} around your formula. (don't type
them yourself.)

Here's the code for the function:

Option Explicit
Function MLookup(LookupRng As Range, OffsetVal As Long, LookupVal As Range)
Dim r As Range
Dim myArr() As Variant
Dim aCtr As Long
Dim iCtr As Long
Dim HowManyCells As Long

'some validity checks

'single area range
If LookupRng.Areas.Count 1 Then
MLookup = "#Multi Area lookuprng!"
Exit Function
End If

'single column or single row
If Application.Caller.Columns.Count = 1 _
Or Application.Caller.Rows.Count = 1 Then
'ok to continue
Else
MLookup = "#Not a single row or column for output"
Exit Function
End If

'the column to bring back has to be included in your lookuprng
'if it's not in that range, then the function may not
'calculate correctly
If OffsetVal < 0 _
Or OffsetVal LookupRng.Columns.Count Then
MLookup = "Offsetval not in lookuprng"
Exit Function
End If

aCtr = 0
For Each r In LookupRng.Columns(1).Cells
If LCase(r.Value) = LCase(LookupVal.Value) Then
aCtr = aCtr + 1
ReDim Preserve myArr(1 To aCtr)
myArr(aCtr) = r.Offset(0, OffsetVal - 1).Value
End If
Next r

With Application.Caller
HowManyCells = .Rows.Count * .Columns.Count
End With

If aCtr = 0 Then
'nothing matches
Else
If aCtr HowManyCells Then
'not enough cells to hold all the matching values
MLookup = "not enough cells"
Exit Function
Else
If aCtr < HowManyCells Then
'pad those cells with ""'s
ReDim Preserve myArr(1 To HowManyCells)
For iCtr = aCtr + 1 To HowManyCells
myArr(iCtr) = ""
Next iCtr
End If
End If
End If

If Application.Caller.Rows.Count = 1 Then
'output goes in a row
MLookup = myArr
Else
'output goes in a column
MLookup = Application.Transpose(myArr)
End If

End Function


========
I changed the code to ignore case with this line:
If LCase(r.Value) = LCase(LookupVal.Value) Then

Then it'll match the way =vlookup() works.

And I'm not sure what you're using this for, but lots of times, I'll want to see
the output formatted nicely (dates, money, ...)

You may want:
myArr(aCtr) = r.Offset(0, OffsetVal - 1).Text 'not .value












John Foddrill wrote:

Currently the function below returns values and I have the seperated by
carrage return, however i wan to have all the values returned seperated into
new rows. Is there a way to get the data back seperated into new rows using
a subroutine?

Function MLookup(LookupRng As Range, OffsetVal As Integer, LookupVal As Range)
Dim r As Range

For Each r In LookupRng

If r.Value = LookupVal.Value Then
If Len(MLookup) = 0 Then
MLookup = r.Offset(0, OffsetVal - 1).Value
Else

MLookup = MLookup & vbCrLf & r.Offset(0, OffsetVal - 1).Value
End If
End If
Next r
End Function





--

Dave Peterson

Thanks the formula worked great. It took me a bit to understand it, but when
i got a better understanding of how it worked it solved several problems.
Not to mention serveral other solutions. Thanks again.

"Dave Peterson" wrote:

Is this a function that you use in a cell in a worksheet?

If yes, then your function can't insert rows (that's what you meant by new rows,
right?).

But if you already inserted all the rows, you could use a function that returned
an array--but you'll have to use an multicell array formula for this.

This code for this function has a few minor validity checks. You have to use a
single range as the lookuprng. You have to pass it the entire range (just like
=vlookup() and that offsetval column has to be within that range.

If you don't include all the range in your function call, then excel won't know
when to recalculate. So this works like the =vlookup() function. Your key
column has to be the leftmost column in the range. (You could add another parm
that specifies that key column if you really needed to--but passing two ranges
(like =index(match()) would be simpler.

Anyway...

This is what the function would look like in a worksheet cell:
=mlookup(sheet2!A1:D20,4,x9)

And you have to select as many rows (or columns) as you think you need. If
you're use too few, you'll get an error. If you use too many, the function will
pad those additional cells with blanks.

So you would select (say) A1:A10 (or A1:J1 for a single row) and type the
formula:
=mlookup(A1:D20,1,$A$1)

This is an array formula. Hit ctrl-shift-enter instead of enter. If you do it
correctly, excel will wrap curly brackets {} around your formula. (don't type
them yourself.)

Here's the code for the function:

Option Explicit
Function MLookup(LookupRng As Range, OffsetVal As Long, LookupVal As Range)
Dim r As Range
Dim myArr() As Variant
Dim aCtr As Long
Dim iCtr As Long
Dim HowManyCells As Long

'some validity checks

'single area range
If LookupRng.Areas.Count 1 Then
MLookup = "#Multi Area lookuprng!"
Exit Function
End If

'single column or single row
If Application.Caller.Columns.Count = 1 _
Or Application.Caller.Rows.Count = 1 Then
'ok to continue
Else
MLookup = "#Not a single row or column for output"
Exit Function
End If

'the column to bring back has to be included in your lookuprng
'if it's not in that range, then the function may not
'calculate correctly
If OffsetVal < 0 _
Or OffsetVal LookupRng.Columns.Count Then
MLookup = "Offsetval not in lookuprng"
Exit Function
End If

aCtr = 0
For Each r In LookupRng.Columns(1).Cells
If LCase(r.Value) = LCase(LookupVal.Value) Then
aCtr = aCtr + 1
ReDim Preserve myArr(1 To aCtr)
myArr(aCtr) = r.Offset(0, OffsetVal - 1).Value
End If
Next r

With Application.Caller
HowManyCells = .Rows.Count * .Columns.Count
End With

If aCtr = 0 Then
'nothing matches
Else
If aCtr HowManyCells Then
'not enough cells to hold all the matching values
MLookup = "not enough cells"
Exit Function
Else
If aCtr < HowManyCells Then
'pad those cells with ""'s
ReDim Preserve myArr(1 To HowManyCells)
For iCtr = aCtr + 1 To HowManyCells
myArr(iCtr) = ""
Next iCtr
End If
End If
End If

If Application.Caller.Rows.Count = 1 Then
'output goes in a row
MLookup = myArr
Else
'output goes in a column
MLookup = Application.Transpose(myArr)
End If

End Function


========
I changed the code to ignore case with this line:
If LCase(r.Value) = LCase(LookupVal.Value) Then

Then it'll match the way =vlookup() works.

And I'm not sure what you're using this for, but lots of times, I'll want to see
the output formatted nicely (dates, money, ...)

You may want:
myArr(aCtr) = r.Offset(0, OffsetVal - 1).Text 'not .value












John Foddrill wrote:

Currently the function below returns values and I have the seperated by
carrage return, however i wan to have all the values returned seperated into
new rows. Is there a way to get the data back seperated into new rows using
a subroutine?

Function MLookup(LookupRng As Range, OffsetVal As Integer, LookupVal As Range)
Dim r As Range

For Each r In LookupRng

If r.Value = LookupVal.Value Then
If Len(MLookup) = 0 Then
MLookup = r.Offset(0, OffsetVal - 1).Value
Else

MLookup = MLookup & vbCrLf & r.Offset(0, OffsetVal - 1).Value
End If
End If
Next r
End Function





--

Dave Peterson