Excel 2016: Runtime Tabstrip From Named Range

jedwardo

Board Regular
Joined
Aug 21, 2012
Messages
122
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:

Code:
[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]

Code:
[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
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

jedwardo

Board Regular
Joined
Aug 21, 2012
Messages
122
I actually got this one working with these 2 subs. Select case is a little bloated and redundant but seems to be operational.

Code:
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

Code:
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

Board Regular
Joined
Aug 21, 2012
Messages
122
Got it condensed, here it is for reference. I'll stop double posting now.

Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,123,271
Messages
5,600,650
Members
414,399
Latest member
Ninjee

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top