Hyperlink to highlighted headers

[Serafin54]

Hello. Not sure if something like this is even possible but trying to figure something out. I have this code that creates a table of contents with hyperlinks to all tabs in the workbook which is fine except I can't get the "Table of Contents" page to not be included as well as I'd rather not have the sheet name listed twice, one non HL and one HL.

Dim ws As Worksheet

'color a worksheet, named Sheet1, in green

    Sheets.Add Before:=Sheets(1)
    Sheets(ActiveSheet.Name).Name = "Table of Contents"
    Set ws = Worksheets("Table of Contents")
    ws.Tab.ColorIndex = 4
    
'Add title and formatting

    Range("A2").Select
    Selection.FormulaR1C1 = "Table of Contents"
    Cells.Select
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Regular"

    End With
    Range("A3").Select
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Bold"
        .Size = 20

    End With
    
    
  ' Add Sheet Names in workbook
    
    Dim x As Integer
    For x = 1 To Worksheets.Count
    Cells(x + 4, 2).Value = Worksheets(x).Name
    Next x
    
' Add hypyerlinks to tabs
    
     Dim LastRowColumnB As Long
       LastRowColumnB = Cells(Rows.Count, 2).End(xlUp).Row
       Range("C5:C" & LastRowColumnB).Formula = "=HYPERLINK(""#'""&RC[-1]&""'!A1"",RC[-1])"
       ActiveSheet.UsedRange.EntireColumn.AutoFit

    
End Sub

What I'm trying to add into it is column for any highlighted headers within the workbook that falls in the sheets listed. I don't know if this is even possible. what i envision is going from this...

TOC.xlsx
	A	B	C	D	E	F
1
2	Table of Contents
3
4
5		Table of Contents	Table of Contents
6		East 54	East 54
7		South 22	South 22
8		West 14	West 14
9		West 21	West 21
10
11
12
13
14
15
Current VBA

Cell Formulas
Range	Formula
C5:C9	C5	=HYPERLINK("#'"&B5&"'!A1",B5)

to this....

TOC.xlsx
	A	B	C	D	E	F	G
1
2	Table of Contents
3
4		Sheet Name	Discrepant Column	Reason
5		East 54	Eligible
6		South 22
7		West 14	Active
8			Tagline
9		West 21	Description
10			Tagline
11			Company Email
12			Eligible
13			Active
14
15
16
Notes

The headers are manually highlighted but color could vary. pick of sample layout attached but header values are random. As I said, I'm not even sure if this is possible so if not, closure works too. lol. Thanks!!!!

TOC.xlsx
	A	B	C	D	E	F	G
1	Segment	Fake Company Name	Description	Tagline	Company Email	Eligible	Active
2	West 14	Kreiger Inc	Realigned Discrete Model	Generate Rich E-Markets	yschimmel@altenwerth.com	Yes	NO
3	West 14	Dickens, Auer and Casper	Fully-Configurable Client-Driven Attitude	Recontextualize Viral Initiatives	susie.braun@treutel.com	Yes	Yes
4	West 14	Metz LLC	Multi-Lateral Discrete Neural-Net	Synergize Enterprise Action-Items	gulgowski.ayla@tillman.com	Yes	Yes
5	West 14	Towne PLC	Profit-Focused Bandwidth-Monitored Customerloyalty	Exploit Visionary E-Tailers	schneider.clemmie@marvin.com	Yes	Yes
6	West 14	Dare and Sons	Diverse Systemic Blockchain	Productize Dynamic Content	eboehm@williamson.com	Yes	Yes
7	West 14	Stokes Group	Upgradable Coherent Access	Aggregate Back-End Functionalities	baumbach.frankie@okeefe.com	Yes	Yes
8	West 14	Veum Inc	Function-Based Eco-Centric Opensystem	Seize 24/365 Architectures	oconner.jett@parisian.info	Yes	Yes
9	West 14	Bruen Group	Facetoface Assymetric Initiative		aurelio.barton@bins.org	Yes	Yes
10	West 14	Hettinger-Hegmann	Operative Well-Modulated Alliance	Synergize Frictionless Bandwidth	abernathy.alfredo@altenwerth.com	Yes	Yes
11	West 14	Cremin Ltd	Multi-Tiered Coherent Product	Benchmark Cutting-Edge Partnerships	thompson.cruz@swift.biz	Yes	Yes
12	West 14	Miller-Kemmer	Organic Homogeneous Structure	Utilize Rich Metrics	hayley.anderson@emard.com	Yes	Yes
13	West 14	Huel Ltd	Reactive Fault-Tolerant Access	Monetize User-Centric Applications	efrain58@boyle.org	Yes	Yes
14	West 14	Romaguera-Wuckert	Future-Proofed Mobile Solution	Repurpose Sexy Experiences	houston97@lynch.com	Yes	Yes
15	West 14	Langworth, Rohan and Swaniawski	Adaptive Responsive Encoding	Synthesize Cutting-Edge Webservices	freda97@reichel.org	Yes	Yes
16	West 14	Gorczany-Haley	Front-Line Transitional Projection	Facilitate Visionary E-Commerce	shodkiewicz@ondricka.com	Yes	Yes
17	West 14	Schoen, Schmitt and Lowe	Vision-Oriented Empowering Middleware	Synergize Sticky Experiences	nzulauf@hill.org	Yes	Yes
18	West 14	Mraz-Will	Quality-Focused Demand-Driven Database	Disintermediate Plug-And-Play Users	ftreutel@harber.org	Yes	Yes
West 14

 

[offthelip]

It is very easy to get rid of the "table of contents by changing thise two lines:

  ' Add Sheet Names in workbook
   
    Dim x As Integer
    For x = 2 To Worksheets.Count   ' change start to 2
    Cells(x + 3, 2).Value = Worksheets(x).Name   ' change to x+3
    Next x

The second part of your problem brings in someting totally different so I wouldn't start from your current code. One of the real difficulties is working out how you are going to detect whether a header is highlighted, specially if the color changes

 

[Serafin54]

ah ok. that makes sense to make that change. thanks.

I had a feeling it wouldn't be a simple add to in order to get that info. For the highlighting i was thinking of something like "If Not cell.Interior.ColorIndex = 0 Then" statement for row 1 on each sheet. Though i'm kind of bumping around on this so not sure that's feesable.