Excel 2016: Runtime Tabstrip From Named Range

[jedwardo]

Hello,

I have been trying to create a runtime tabstrip unsuccessfully. I have 4 named ranges I need it to populate the tab names from depending on which tab on ufRooms.tsWood is selected. The 4 named ranges are named the same as the 4 tab names on tsWood ie: Doors, Windows, Trim, MiscWood. All 4 named ranges are on a sheet named "Lists" Here's some code of a couple different runtime tabstrips I lifted that I've been butchering with no luck:

[LEFT][COLOR=#333333][FONT=Verdana]Private Sub UserForm_Initialize()[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Dim ct1 As Control[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana][/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Set ct1 = Controls.Add("Forms.tabstrip.1")[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]ct1.Name = "ts1"[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]ct1.Height = 390[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]ct1.Width = 640[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]ct1.Top = 54[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]ct1.Left = 6[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana][/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]SheetCounter = 0[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana][/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]For Each Sh In Worksheets[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]SheetCounter = SheetCounter + 1[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]If SheetCounter = 1 Then ct1.Tabs("Tab1").Caption = Sh.Name[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]If SheetCounter = 2 Then ct1.Tabs("Tab2").Caption = Sh.Name[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]If SheetCounter > 2 Then ct1.Tabs.Add , Sh.Name[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]Next Sh[/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana][/FONT][/COLOR]
[COLOR=#333333][FONT=Verdana]End Sub[/FONT][/COLOR][/LEFT]

[LEFT][COLOR=#252C2F][FONT=Courier]Private Sub UserForm_Initialize()


   Dim c                As Excel.Range
   Dim t                As Object


   ' Tabstrip named as 'ts' only as it's shorter to type.


   ' Remove additional tabs
   Do While ts.Tabs.Count > 1
      ts.Tabs.Remove (1)
   Loop


   For Each c In Range("WhatEverName")
   ' If a multi column rang4e
   ' For Each c In Range("WhatEverName").Columns(1).Cells
      
      ' Ignore blank cells
      If c.Value <> vbNullString Then
         ' Add tab at the default position (Last)
         Set t = ts.Tabs.Add
         ' Set caption - use .TEXT to get the formatted text from the cell
         t.Caption = c.Text
      End If
   Next


   ' Remove the initial tab.
   ts.Tabs.Remove (1)


End Sub[/FONT][/COLOR][/LEFT]

Trying to get my versions copied but copy/paste isn't working out of excel for some reason at the moment.

Much appreciated,
Jordan

 

[jedwardo]

I actually got this one working with these 2 subs. Select case is a little bloated and redundant but seems to be operational.

Private Sub UserForm_Initialize()


Dim c As Excel.Range
Dim t As Object



   Do While ts.Tabs.Count > 1
      ts.Tabs.Remove (1)
   Loop


   For Each c In Worksheets("Lists").Range("Doors")
 
      If c.Value <> vbNullString Then
         Set t = ts.Tabs.Add
         t.Caption = c.Text
      End If
   Next

   ts.Tabs.Remove (1)

End Sub

Private Sub tsWood_Change()
Dim c As Excel.Range
Dim t As Object
Dim varTab As Variant
'Dim Doors As Range, Windows As Range, Trim As Range, Miscwood As Range, r As Range
'Set Doors = Worksheets("Lists").Range("Doors")
'Set Windows = Worksheets("Lists").Range("Windows")
'Set Trim = Worksheets("Lists").Range("Trim")
'Set Miscwood = Worksheets("Lists").Range("MiscWood")
varTab = ufRooms.tsWood.Value


   Do While ts.Tabs.Count > 1
      ts.Tabs.Remove (1)
   Loop

    Select Case varTab
        Case Is = 0
            
   For Each c In Worksheets("Lists").Range("Doors")

      If c.Value <> vbNullString Then
         Set t = ts.Tabs.Add
         t.Caption = c.Text
          End If
   Next
        Case Is = 1
            
   For Each c In Worksheets("Lists").Range("Windows")

      If c.Value <> vbNullString Then
         Set t = ts.Tabs.Add
         t.Caption = c.Text
          End If
   Next
        Case Is = 2
            
   For Each c In Worksheets("Lists").Range("Trim")

      If c.Value <> vbNullString Then
         Set t = ts.Tabs.Add
         t.Caption = c.Text
          End If
   Next
        Case Is = 3
            
   For Each c In Worksheets("Lists").Range("MiscWood")
 
      If c.Value <> vbNullString Then
         Set t = ts.Tabs.Add
         t.Caption = c.Text
      End If
   Next
   End Select


   ' Remove the initial tab.
   ts.Tabs.Remove (1)
End Sub

 

[jedwardo]

Got it condensed, here it is for reference. I'll stop double posting now.

Private Sub tsWood_Change()
Dim c As Excel.Range
Dim t As Object
Dim varTab As Variant
Dim r As String

varTab = ufRooms.tsWood.Value
r = ufRooms.tsWood.SelectedItem.Caption

   Do While ts.Tabs.Count > 1
      ts.Tabs.Remove (1)
   Loop

    Select Case varTab
    
        Case Is = 0, 1, 2, 3
 
           For Each c In Worksheets("Lists").Range(r)
              If c.Value <> vbNullString Then
                 Set t = ts.Tabs.Add
                 t.Caption = c.Text
                  End If
           Next
           
   End Select

   ts.Tabs.Remove (1)
End Sub