Pass non active workbook range to Function

**nemmi69** · 08-25-2011, 09:56 AM

I want to be able to pass to the function a range in a workbook that is not the current workbook as can be done with worksheetfunction IE Application.worksheetfunction.sum(Workbooks(WBname).Sheets(WSname).Range("A1:A10")

Function RLookup(RLVal, RLrange As Range, Optional Occur As Integer) As Integer
Dim Rowloop, Colloop, RLrow1, RLrow2, RLcol1, RLcol2 As Integer
Dim WBname, WSname As String

If Occur = 0 Then
Occur = 1
End If

On Error GoTo RLErr_rng:
WSname = Range(RLrange).Parent.Name
WBname = Sheets(WSname).Parent.Name

RLrow1 = Range(RLrange).Row
RLcol1 = Range(RLrange).Column
RLrow2 = Range(RLrange).Rows.Count
RLcol2 = Range(RLrange).Columns.Count

On Error GoTo RLErr_val:
For Rowloop = RLrow1 To RLrow2
For Colloop = RLcol1 To RLcol2
'stuff to do
Next Colloop
Next Rowloop

RLErr_rng:
RLookup = -2
Exit Function

RLErr_val:
RLookup = -3
Exit Function

End Function

Sub test()
Dim x As Integer
Dim WBname, WSname, Rrange As String
WBname = "RLookup.xls"
WSname = "Sheet1"
x = RLookup(1, Workbooks(WBname).Sheets(WSname).Range("A1:A10"))
MsgBox x
End Sub

**p24leclerc** · 08-25-2011, 09:01 PM

Here is what I was able to do with your function. I had to change it a little bit but it seems to work.

Function RLookup(RLVal, WSname As String, wbname As String, RLrange As Range, Optional Occur As Integer) As Integer
Dim Rowloop, Colloop, RLrow1, RLrow2, RLcol1, RLcol2 As Integer
'Dim wbname, WSname As String

If Occur = 0 Then
Occur = 1
End If

On Error GoTo RLErr_rng:
Workbooks("RLookup.xls").Worksheets("Sheet1").Activate
RLrow1 = RLrange.Row
RLcol1 = RLrange.Column
RLrow2 = RLrange.Rows.Count
RLcol2 = RLrange.Columns.Count

On Error GoTo RLErr_val:
For Rowloop = RLrow1 To RLrow2
For Colloop = RLcol1 To RLcol2
'stuff to do
a = Cells(Rowloop, Colloop)
Next Colloop
Next Rowloop
RLookup = 0
Exit Function

RLErr_rng:
RLookup = -2
Exit Function

RLErr_val:
RLookup = -3
Exit Function

End Function

Sub test()
Dim x As Integer
Dim B_name As String, S_name As String
B_name = "RLookup.xls"
S_name = "Sheet1"
x = RLookup(1, S_name, B_name, Range("A1:A10"))
MsgBox x
End Sub

**nemmi69** · 08-26-2011, 02:34 AM

Thanks for that. The idea was to make it work as the inbuilt functions do in that they can break the code down and extract the workbook and worksheet from the supplied range with out supplying them independantly.

**nemmi69** · 08-26-2011, 04:07 AM

I did get the sheet name by changing

"WSname = Range(RLrange).Parent.Name"

with

"WSname = RLrange.Parent.Name"

but I can't see how to get it to yield the workbook name. If the code continues it will use which ever workbook is active.

**nemmi69** · 08-26-2011, 06:49 AM

I have it working mostly now. but it wont return the range it returns the value.

Function RLookup(RLVal, RLrange As Range, Optional Occur As Integer) As Range
Dim Rowloop, Colloop, RLrow1, RLrow2, RLcol1, RLcol2 As Integer
Dim WBname, WSname, WRname As String

If Occur = 0 Then
    Occur = 1
End If

'On Error GoTo RLErr_rng:
WSname = RLrange.Parent.Name
WBname = RLrange.Worksheet.Parent.Name
WRname = RLrange.Address

RLrow1 = RLrange.Row
RLcol1 = RLrange.Column
RLrow2 = RLrange.Rows.Count
RLcol2 = RLrange.Columns.Count

'On Error GoTo RLErr_val:
For Rowloop = RLrow1 To RLrow2
    For Colloop = RLcol1 To RLcol2
        If Workbooks(WBname).Sheets(WSname).Range(Cells(Rowloop, Colloop).Address).Value = RLVal Then
           Set RLookup = Workbooks(WBname).Sheets(WSname).Range(Cells(Rowloop, Colloop).Address).Address
           Exit Function
        End If
    Next Colloop
Next Rowloop

RLErr_rng:
RLookup = -2
Exit Function

RLErr_val:
RLookup = -3
Exit Function

End Function

Sub test()
Dim x As Range
Dim WBname, WSname, Rrange As String
WBname = "RLookup.xls"
WSname = "Sheet1"
Set x = RLookup(1, Workbooks(WBname).Sheets(WSname).Range("A1:A10"))
MsgBox "Row :" = Range(x).Row & " - Column : " & Range(x).Column
End Sub

**p24leclerc** · 08-27-2011, 08:20 PM

Here are 2 problems I found:

First, when you set the Rlookup range in the function. You just need to do the following:

Set RLookup = Workbooks(WBname).Sheets(WSname).Range(Cells(Rowloop, Colloop).Address)

By putting the .Address, the value is no longer a range.

Second, when you show the message box, as x is already a range you just have to do this:

MsgBox "Row :" & x.Row & " - Column : " & x.Column

Good luck
Pierre

**nemmi69** · 08-30-2011, 03:05 AM

Originally Posted by p24leclerc

Here are 2 problems I found:

First, when you set the Rlookup range in the function. You just need to do the following:

Set RLookup = Workbooks(WBname).Sheets(WSname).Range(Cells(Rowloop, Colloop).Address)

By putting the .Address, the value is no longer a range.

Second, when you show the message box, as x is already a range you just have to do this:

MsgBox "Row :" & x.Row & " - Column : " & x.Column

Good luck
Pierre

If I take the .address of then Rlookup returns the value 1 and if I do not 'set' x then I get the message "object variable or with block variable not set"

**nemmi69** · 08-30-2011, 03:34 AM

This seems to be a good way to do it. I set 'x' and the function to a string. I haven't adjusted the test to take in to account if an error is returned but that would just be an IF statement. Thanks for the help everyone , let me know if you spot any potential problems.

Function RLookup(RLVal, RLrange As Range, Optional Occur As Integer) As String
Dim Rowloop, Colloop, RLrow1, RLrow2, RLcol1, RLcol2 As Integer
Dim WBname, WSname, WRname As String

If Occur = 0 Then
    Occur = 1
End If

On Error GoTo RLErr_rng:

WSname = RLrange.Parent.Name
WBname = RLrange.Worksheet.Parent.Name
WRname = RLrange.Address

RLrow1 = RLrange.Row
RLcol1 = RLrange.Column
RLrow2 = RLrange.Rows.Count
RLcol2 = RLrange.Columns.Count

On Error GoTo RLErr_val:
For Rowloop = RLrow1 To RLrow2
    For Colloop = RLcol1 To RLcol2
        If Workbooks(WBname).Sheets(WSname).Range(Cells(Rowloop, Colloop).Address).Value = RLVal Then
           RLookup = Cells(Rowloop, Colloop).Address
           Exit Function
        End If
    Next Colloop
Next Rowloop

RLErr_rng:
RLookup = -2
Exit Function

RLErr_val:
RLookup = -3
Exit Function

End Function

Sub test()
Dim x As String
Dim TWBname, TWSname As String
TWBname = "RLookup.xls"
TWSname = "Sheet1"
 x = RLookup(1, Workbooks(TWBname).Sheets(TWSname).Range("A1:A10"))
MsgBox "Row :" & Range(x).Row & " - Column : " & Range(x).Column
End Sub

**p24leclerc** · 08-30-2011, 08:45 AM

Try this code and llok at the attached files. It works like you want. It will returns row-6 column-1 in the message box. Note that the function returns 1 because you are asking it to look for this value in the function call. The important thing is to look at the address where the function found this value.

Set x = RLookup(1, Workbooks(WBname).Sheets(WSname).Range("A1:A10"))

The 1 you see in the call is the RLval the function will look for in your range.

Function RLookup(RLVal, RLrange As Range, Optional Occur As Integer) As Range
Dim Rowloop, Colloop, RLrow1, RLrow2, RLcol1, RLcol2 As Integer
Dim WBname, WSname, WRname As String

If Occur = 0 Then
    Occur = 1
End If

'On Error GoTo RLErr_rng:
WSname = RLrange.Parent.Name
WBname = RLrange.Worksheet.Parent.Name
WRname = RLrange.Address

RLrow1 = RLrange.Row
RLcol1 = RLrange.Column
RLrow2 = RLrange.Rows.Count
RLcol2 = RLrange.Columns.Count

'On Error GoTo RLErr_val:
For Rowloop = RLrow1 To RLrow2
    For Colloop = RLcol1 To RLcol2
        If Workbooks(WBname).Sheets(WSname).Range(Cells(Rowloop, Colloop).Address).Value = RLVal Then
           Set RLookup = Workbooks(WBname).Sheets(WSname).Range(Cells(Rowloop, Colloop).Address)
           Exit Function
        End If
    Next Colloop
Next Rowloop

RLErr_rng:
RLookup = -2
Exit Function

RLErr_val:
RLookup = -3
Exit Function

End Function

Sub test()
Dim x As Range
Dim WBname, WSname, Rrange As String
WBname = "RLookup.xls"
WSname = "Sheet1"
Set x = RLookup(1, Workbooks(WBname).Sheets(WSname).Range("A1:A10"))
MsgBox "Row :" & x.Row & " - Column : " & x.Column
End Sub

Regards
Pierre