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 35100000Here 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

✔ 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 SubI 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 SubI 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.

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

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

Thanks that fixed it. The orginal post is now formated

Is it possible to get any help on this?

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 SubI 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 SubI 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.

PERFECT!!!!! Thank you so much.

Ask Your Question

Weekly Poll