The Dynamic VLook up Using VBA

Question

The procedure which I am trying to design, searches the table array automatically and performs the vlookup function. Suppose a workbook have following sheets each have a range containing the “Total” key word :

BBSR
Guwahati
Siliguri
KolkataKG
KolkataHowrahKG
PatnaBo
Jamshedpur
Muzzafarpur

For example the sheet “BBSR” contains a range: $B$18:$E$18, where “Total” keyword resides at leftmost corner. In other sheets, there is same range but residing at different address i.e. the row number varies from sheet to sheet e.g. $B$20:$E$20, $B$26:$E$26.

I wanted to prepare such a Function Procedure that accepts a sheet name as its argument and then searches the range and performs the Vlookup operation. Here, I want to lookup Column No. 4 with respect to “Total” Key word in each sheet. The following is the code:

Function FINDROWNUM(sht As Worksheet) As Long

Dim Rw As Long

Rw = sht.Cells.Find(what:="Total", After:=Range("A1"), LookIn:=xlFormulas, Lookat:=xlPart,Searchorder:=xlByRows, searchdirection:=xlPrevious, MatchCase:=False).Row

MsgBox Rw

FINDROWNUM = Rw

End Function

Function FINDCOLUMN(sht As Worksheet)

Dim col As Long

col = sht.Cells.Find(what:="Total", After:=Range("A1"), LookIn:=xlFormulas, Lookat:=xlPart, Searchorder:=xlByColumns, searchdirection:=xlPrevious, MatchCase:=False).Column

FINDCOLUMN = col

End Function

Function NEWVLOOKUP1(sht As Worksheet) As Long

Dim RowNum As Long

Dim ColNum As Long

Dim Rng As Range

RowNum = FINDROWNUM(sht)

ColNum = FINDCOLUMN(sht)

Set Rng = Range(Cells(RowNum, ColNum), Cells(RowNum, ColNum).Offset(0, 3))

NEWVLOOKUP1 = Application.WorksheetFunction.VLookup("Total", Rng.Address, 4, 0)

End Function

The function NEWVLOOKUP1 seems to create problem and hence is not working and showing #VALUE! Error. To test my code I introduced the following Sub Procedure that shows address of the Vlookup Range in “BBSR” Sheet :

Sub ShowAddress()

Dim RowNum As Long

Dim ColNum As Long

Dim Rng As Range

Dim Addr As String

Dim sht As Worksheet

Set sht = ActiveWorkbook.Worksheets("BBSR")

RowNum = FINDROWNUM(sht)

ColNum = FINDCOLUMN(sht)

Set Rng = Range(Cells(RowNum, ColNum), Cells(RowNum, ColNum).Offset(0, 3))

Addr = Rng.Address

MsgBox Addr

End Sub

And this time the Message box showed the address of Vlookup range $B$18:$E$18 ! and it seems that I am going in right direction.

Now, My question is What Modification is to be made in NEWVLOOKUP1 Function procedure so that it accepts a worksheet name of activeworkbook as its argument and then searches the lookup range and performs the vlookup function ?

Answer 1

JLLatham,

Where you say:

NEWLOOKUP1 = "No Total Available" ' change as you desire

I am guessing you meant that should say NewVlookup  (add in the "V")

--

Regards,

Tom Ogilvy

Answer 2

Thanks, that's a useful addition.

Answer 3

Hans V's shorter and more efficient code is the way I'd go, with just one addition to test the result if it just so happens that "Total" doesn't appear on the sheet. Notice I changed the return type of the function from Long to Variant:

Function NEWVLOOKUP1(SheetName As String) As Variant

     Dim sht As Worksheet

    Dim rng As Range

    Set sht = Worksheets(SheetName)

    Set rng = sht.Cells.Find(What:="Total", After:=sht.Range("A1"), _

        LookIn:=xlFormulas, Lookat:=xlPart, Searchorder:=xlByRows, _

        Searchdirection:=xlPrevious, MatchCase:=False)

'set up an 'error' return value first

NEWVLOOKUP1 = "No Total Available" ' change as you desire

If Not rng Is Nothing Then

NEWVLOOKUP1 = rng.Offset(0, 3).Value

End If

End Function

Answer 4

In the first place, the argument to NEWVLOOKUP1 should be a String, not a Worksheet, since you want to pass the name of the worksheet to the function.

In the second place, you must consistently refer to the worksheet you want to look at.

Range("A1") will always be on the activesheet.

sht.Range("A1") will be on the sheet you want to look at.

In the third place, there is no need to use VLOOKUP. Once you have found the cell with "TOTAL", you only need to look at the cell 3 columns to the right.

This should work:

Function FINDROWNUM(sht As Worksheet) As Long

    Dim Rw As Long

    Rw = sht.Cells.Find(What:="Total", After:=sht.Range("A1"), _

        LookIn:=xlFormulas, Lookat:=xlPart, Searchorder:=xlByRows, _

        Searchdirection:=xlPrevious, MatchCase:=False).Row

    FINDROWNUM = Rw

End Function

Function FINDCOLUMN(sht As Worksheet)

    Dim col As Long

    col = sht.Cells.Find(What:="Total", After:=sht.Range("A1"), _

        LookIn:=xlFormulas, Lookat:=xlPart, Searchorder:=xlByColumns, _

        Searchdirection:=xlPrevious, MatchCase:=False).Column

    FINDCOLUMN = col

End Function

Function NEWVLOOKUP1(SheetName As String) As Long

    Dim sht As Worksheet

    Dim RowNum As Long

    Dim ColNum As Long

    Set sht = Worksheets(SheetName)

    RowNum = FINDROWNUM(sht)

    ColNum = FINDCOLUMN(sht)

    NEWVLOOKUP1 = sht.Cells(RowNum, ColNum + 3).Value

End Function

Shorter and more efficient:

Function NEWVLOOKUP1(SheetName As String) As Long

    Dim sht As Worksheet

    Dim rng As Range

    Set sht = Worksheets(SheetName)

    Set rng = sht.Cells.Find(What:="Total", After:=sht.Range("A1"), _

        LookIn:=xlFormulas, Lookat:=xlPart, Searchorder:=xlByRows, _

        Searchdirection:=xlPrevious, MatchCase:=False)

    NEWVLOOKUP1 = rng.Offset(0, 3).Value

End Function

Use like this:

=NEWVLOOKUP1("BBSR")

Answer 5

Hi,

Set Rng = Range(Cells(RowNum, ColNum), Cells(RowNum, ColNum).Offset(0, 3)) is not referring to "sht" but to the activesheet were you use NEWVLOOKUP1.

Try this

Set Rng = Sheets(sht).Range(Cells(RowNum, ColNum), Cells(RowNum, ColNum).Offset(0, 3))

You can test the location of Rng in the immediate window:

? Rng.Parent.Name

This will return the sheet name.