VBA Rename a TAB to the First 12 Chracters of a Cell String

SamBo1234

Board Regular
Joined
Aug 21, 2006
Messages
77
Hi ya'll and good morning,

First problem of the day,

I need some VBA code to help me rename the TAB (Of the Worksheet) to a Cell....

However i only want to rename the Sheet Name to the first 12 chracters of the Cell containing the string...

So for example in A1 it has Missing_Data_&1234_*Hello_%goodbye

Because you cant use special chracters on the names of tabs i only want to return the first 12 chracters so it would basically be 'Missing_Data'
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

itlsbu

Board Regular
Joined
Jul 2, 2002
Messages
102
SamBo,

would this help

Sub macro1()

Dim name1 As String

Range("a2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],12)"
name1 = range("a2")

ActiveSheet.Name = name1
End Sub

cheers steven
 

SamBo1234

Board Regular
Joined
Aug 21, 2006
Messages
77
Hi there,

Im getting the following error,


Application-defined or object-defined error
 

Darren Bartrup

Well-known Member
Joined
Mar 13, 2006
Messages
1,296
Office Version
  1. 365
Platform
  1. Windows
How about this way:

To run the two procedures:
Code:
Public Sub Demo()

    Rename_Sheet ThisWorkbook.Worksheets(1)
    Rename_Sheet_Alternate ThisWorkbook.Worksheets(1)

End Sub
Replace any illegal characters in worksheet name with an underscore:
Code:
Public Sub Rename_Sheet(wrksht As Worksheet)

    Dim ReplaceString(1 To 7)   As String
    Dim NewSheetName            As String
    Dim iCntr                   As Integer

    ReplaceString(1) = "\"
    ReplaceString(2) = "/"
    ReplaceString(3) = "?"
    ReplaceString(4) = "*"
    ReplaceString(5) = "["
    ReplaceString(6) = "]"
    ReplaceString(7) = "'"
'    ReplaceString(8) = "&"
'    ReplaceString(9) = "%"
    
    NewSheetName = wrksht.Cells(1, 1)
    For iCntr = LBound(ReplaceString) To UBound(ReplaceString)
        NewSheetName = Replace(NewSheetName, ReplaceString(iCntr), "_")
    Next iCntr

    wrksht.Name = Trim(NewSheetName)

End Sub
Use first 12 characters of string in cell A1:
Code:
Public Sub Rename_Sheet_Alternate(wrksht As Worksheet)

    wrksht.Name = Left(wrksht.Cells(1, 1), 12)

End Sub

Edit: My bad, % and & aren't illegal so edited them out. :oops:
 

Richard Schollar

MrExcel MVP
Joined
Apr 19, 2005
Messages
23,707

ADVERTISEMENT

Or simply:

Code:
Sheets("Sheet1").Name = Left$(Sheets("Sheet1").Range("A1").Value,12)

Richard
 

SamBo1234

Board Regular
Joined
Aug 21, 2006
Messages
77
Hi and thanks for your replies guys,

Im trying to get it to work with the following code...

Code:
Option Explicit

Sub CombineWorkbooks()
    Dim FilesToOpen
    Dim x As Integer
    Dim ShCnt As Integer
    Dim i As Integer, strFile As String
    
    
         
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
      MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    strFile = Right(FilesToOpen(1), Len(FilesToOpen(1)) - InStrRev(FilesToOpen(1), "\"))
    While x <= UBound(FilesToOpen)
        Workbooks.Open Filename:=FilesToOpen(x)
        If x = 1 Then
             For i = 1 To Workbooks(strFile).Sheets.Count
                    Rows("1:2").Select
                    Selection.EntireRow.Insert
                    Workbooks(strFile).Sheets(i).Range("A1") = Dir(FilesToOpen(x))
                    Workbooks(strFile).Sheets(i).Range("A1").Font.Bold = True
                    Range("A2:A" & Rows.Count).Columns.AutoFit
                    Columns("B:H").AutoFit
                    Sheets("Sheet1").Name = Left$(Sheets("Sheet1").Range("A1").Value, 12)
                    Next i
         End If
        With Workbooks(strFile)
                ShCnt = .Sheets.Count
                Sheets().Move After:=.Sheets(ShCnt)
                For i = ShCnt + 1 To .Sheets.Count
                Rows("1:2").Select
                Selection.EntireRow.Insert
                   .Sheets(i).Range("A1") = Dir(FilesToOpen(x))
                   .Sheets(i).Range("A1").Font.Bold = True
                   Range("A2:A" & Rows.Count).Columns.AutoFit
                    Columns("B:H").AutoFit
                
                   Next i
        End With
        x = x + 1
    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

Richard, i tryed to include your line of code here,

Code:
  For i = 1 To Workbooks(strFile).Sheets.Count
                    Rows("1:2").Select
                    Selection.EntireRow.Insert
                    Workbooks(strFile).Sheets(i).Range("A1") = Dir(FilesToOpen(x))
                    Workbooks(strFile).Sheets(i).Range("A1").Font.Bold = True
                    Range("A2:A" & Rows.Count).Columns.AutoFit
                    Columns("B:H").AutoFit
                    Sheets("Sheet1").Name = Left$(Sheets("Sheet1").Range("A1").Value, 12)
                    Next i

But im getting the following error:


Subscript out of range


Havent tryed the other alternatives... ill give it a whirl.
 

Richard Schollar

MrExcel MVP
Joined
Apr 19, 2005
Messages
23,707
Subscript out of range error suggests you don't have a sheet named Sheet1. You're using i to refer to the sheet in the code, so use this again:

Code:
Sheets(i).Name = Left$(Sheets(i).Range("A1").Value, 12)

Make sure that it is the value in A1 that you want to be picking up.

Richard
 

Forum statistics

Threads
1,136,268
Messages
5,674,734
Members
419,523
Latest member
Urnovio

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