Solved Add a vlookup to an existing VBA code

August 26, 2013 at 05:09:29
Specs: Windows XP
Hi to all you great helpers. I would like to add some vlookups to a code that creates a table of content (TOC) page with hyperlinks for each worksheet in the workbook. The code for creating the TOC works great. and the Vlooks works (though I have to paste the vlookups in E4 and G4 then copy down on the TOC but I could fix with a macro) I have tried many different things in the TOC code but nothing I do seems to work. The data for the Vlookups are on a worksheet called sheet2. The same data is on each worksheet which were used to Create the TOC in cells B2 and C2 for that location.

Sheet2 has all the data but each worksheet only has the data for that location. The individual sheets are created by another code which copy a header row and a row of information from sheet 2. For example worksheet 10061063 will have a Header Row and a row 2 with
A B C
10061063 BLDG, ADMI OFFICE W/ SEPTIC 35100000

Here is the code I use for creating the TOC

Sub CreateTOC()
'Declare all variables
    Dim ws As Worksheet, curws As Worksheet, shtName As String
    Dim nRow As Long, i As Long, N As Long, x As Long, tmpCount As Long
    Dim cLeft, cTop, cHeight, cWidth, cb As Shape, strMsg As String
    Dim cCnt As Long, cAddy As String, cShade As Long
     'Check if a workbook is open or not.  If no workbook is open, quit.
    If ActiveWorkbook Is Nothing Then
        MsgBox "You must have a workbook open first!", vbInformation, _
                "No Open Book"
        Exit Sub
    End If
     '--------------------------------------------------------
    cShade = 37 '<<== SET BACKGROUND COLOR DESIRED HERE
     '--------------------------------------------------------
     'Turn off events and screen flickering.
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    nRow = 4: x = 0
     'Check if sheet exists already; direct where to go if not.
    On Error GoTo hasSheet
    Sheets("TOC").Activate
     'Confirm the desire to overwrite sheet if it exists already.
    If MsgBox("You already have a Table of Contents page." _
    & vbLf & vbLf & _
    "Would you like to overwrite it?", _
    vbYesNo + vbQuestion, "Replace TOC page?") = vbYes Then GoTo createNew
    Exit Sub
hasSheet:
    x = 1
     'Add sheet as the first sheet in the workbook.
    Sheets.Add before:=Sheets(1)
    GoTo hasNew
createNew:
    Sheets("TOC").Delete
    GoTo hasSheet
hasNew:
     'Reset error statment/redirects
    On Error GoTo 0
     'Set chart sheet varible counter
    tmpCount = ActiveWorkbook.Charts.Count
    If tmpCount > 0 Then tmpCount = 1
     'Set a formatting for the TOC sheet.
    ActiveSheet.Name = "TOC"
    With Sheets("TOC")
        .Cells.Interior.ColorIndex = cShade
        .Rows("4:65536").RowHeight = 16
        .Range("A2").Value = "Table of Contents"
        .Range("A2").Font.Bold = True
        .Range("A2").Font.Name = "Arial"
        .Range("A2").Font.Size = "24"
        .Range("A4").Select
    End With
     'Set variables for loop/iterations
    N = ActiveWorkbook.Sheets.Count + tmpCount
    If x = 1 Then N = N - 1
    For i = 2 To N
        With Sheets("TOC")
                shtName = Sheets(i).Name
                 'Add a hyperlink to A1 of each sheet.
                .Range("C" & nRow).Hyperlinks.Add _
                Anchor:=.Range("C" & nRow), Address:="#'" & _
                shtName & "'!A1", TextToDisplay:=shtName
                .Range("C" & nRow).HorizontalAlignment = xlLeft
            .Range("B" & nRow).Value = nRow - 2
            nRow = nRow + 1
        End With
continueLoop:
    Next i
     'Perform formatting.
    With Sheets("TOC")
        .Range("C:C").EntireColumn.AutoFit
        .Range("A4").Activate
    End With
     'Turn events back on.
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    strMsg = vbNewLine & vbNewLine & "Please note: " & _
    "Charts will have hyperlinks associated with an object."
     'Toggle message box for chart existence or not, information only.
    If cCnt = 0 Then strMsg = ""
    MsgBox "Complete!" & strMsg, vbInformation, "Complete!"
End Sub

Here are the Vlooks I am using in Cell E4 of the TOC
=IF(ISERROR(VLOOKUP(C4,Sheet2!$A$2:$D$51,2,)),"",VLOOKUP(C4,Sheet2!$A$2:$D$51,2,FALSE))

And in Cell G4 of the TOC =IF(ISERROR(VLOOKUP(C4,Sheet2!$A$2:$D$51,3,)),"",VLOOKUP(C4,Sheet2!$A$2:$D$51,3,FALSE))


message edited by garmelvin


See More: Add a vlookup to an existing VBA code

Report •


✔ Best Answer
August 28, 2013 at 12:15:43
It's hard to test an exact solution since we don't have a copy of your workbook, but
here's what I tried. Maybe you can work with this and modify it to fit your needs.

I ran your TOC code in a blank workbook which contained 3 sheets: Sheet1,
Sheet2 & Sheet3.

The code produced this TOC:

     A     B      C
           2    Sheet1
           3    Sheet2


I then recorded a macro as I pasted your formulas into E4 and G4, which produced
this code:

Sub Macro4()
'
' Macro4 Macro
'

'
    Range("E4").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC[-2],Sheet2!R2C1:R51C4,2,)),"""",VLOOKUP(RC[-2],Sheet2!R2C1:R51C4,2,FALSE))"
    Range("G4").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC[-4],Sheet2!R2C1:R51C4,3,)),"""",VLOOKUP(RC[-4],Sheet2!R2C1:R51C4,3,FALSE))"
End Sub

I then modified the recorded code to place the formulas in Column E & G, starting in
Row 4 and down to the last row with data in Column C.

Sub InsertVLOOKUPS()
    lastRw = Sheets("TOC").Range("C" & Rows.Count).End(xlUp).Row
     Sheets("TOC").Range("E4:E" & lastRw).FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC[-2],Sheet2!R2C1:R51C4,2,)),"""",VLOOKUP(RC[-2],Sheet2!R2C1:R51C4,2,FALSE))"
     Sheets("TOC").Range("G4:G" & lastRw).FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC[-4],Sheet2!R2C1:R51C4,3,)),"""",VLOOKUP(RC[-4],Sheet2!R2C1:R51C4,3,FALSE))"
End Sub

I then inserted that code (without the Sub/End Sub lines of course) before the "Complete!"
message instruction in your TOC macro.

Give that a try and let us know how it works for you.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.



#1
August 26, 2013 at 05:21:06
I cannot understand this when I previewed my post the code looked fine but now the formating changed back to no indentions. When I try to edit the code it also looks fine

message edited by garmelvin


Report •

#2
August 26, 2013 at 05:35:19
when I previewed my post the code looked fine but now the formating changed back to no indentions.

You need to use the < pre > tags around your code.
Read this How-To:

http://www.computing.net/howtos/sho...

MIKE

http://www.skeptic.com/


Report •

#3
August 26, 2013 at 05:39:59
Thanks that fixed it. The orginal post is now formated

Report •

Related Solutions

#4
August 28, 2013 at 07:36:25
Is it possible to get any help on this?

Report •

#5
August 28, 2013 at 12:15:43
✔ Best Answer
It's hard to test an exact solution since we don't have a copy of your workbook, but
here's what I tried. Maybe you can work with this and modify it to fit your needs.

I ran your TOC code in a blank workbook which contained 3 sheets: Sheet1,
Sheet2 & Sheet3.

The code produced this TOC:

     A     B      C
           2    Sheet1
           3    Sheet2


I then recorded a macro as I pasted your formulas into E4 and G4, which produced
this code:

Sub Macro4()
'
' Macro4 Macro
'

'
    Range("E4").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC[-2],Sheet2!R2C1:R51C4,2,)),"""",VLOOKUP(RC[-2],Sheet2!R2C1:R51C4,2,FALSE))"
    Range("G4").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC[-4],Sheet2!R2C1:R51C4,3,)),"""",VLOOKUP(RC[-4],Sheet2!R2C1:R51C4,3,FALSE))"
End Sub

I then modified the recorded code to place the formulas in Column E & G, starting in
Row 4 and down to the last row with data in Column C.

Sub InsertVLOOKUPS()
    lastRw = Sheets("TOC").Range("C" & Rows.Count).End(xlUp).Row
     Sheets("TOC").Range("E4:E" & lastRw).FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC[-2],Sheet2!R2C1:R51C4,2,)),"""",VLOOKUP(RC[-2],Sheet2!R2C1:R51C4,2,FALSE))"
     Sheets("TOC").Range("G4:G" & lastRw).FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC[-4],Sheet2!R2C1:R51C4,3,)),"""",VLOOKUP(RC[-4],Sheet2!R2C1:R51C4,3,FALSE))"
End Sub

I then inserted that code (without the Sub/End Sub lines of course) before the "Complete!"
message instruction in your TOC macro.

Give that a try and let us know how it works for you.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#6
August 28, 2013 at 12:50:41
PERFECT!!!!! Thank you so much.

Report •


Ask Question