• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 166
  • Last Modified:

Changing tab labeles after appending to a workbook

Folks,
My client needed the ability to append to an existing workbook. That solution has been provided - awesome.
Ok, now that the new workbook has new worksheets I would appreciate a macro that allows the user to change the tabs of the appended worksheets. Each append tab is labeled Jan, Feb, Mar, etc. The new tabs would be tabled Jan 15, Feb 15, Mar 15. I would label the macro change tab dates
0
Frank Freese
Asked:
Frank Freese
  • 9
  • 5
  • 4
2 Solutions
 
Randy PooleCommented:
Sub ChangeTabNames(append As String)
    Dim xls As Excel.Worksheet
    Dim sn() As String
    Dim csn As String
    Dim l As Integer
    append = Trim(append)
    sn = Split("JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC", ",")
    
    For Each xls In ActiveWorkbook.Sheets
        For l = LBound(sn) To UBound(sn)
            If UCase(xls.Name) = sn(l) Then
                xls.Name = xls.Name & " " & append
                Exit For
            End If
        Next l
    Next xls
    
End Sub
Sub RenameSheets()
    ChangeTabNames ("15")
End Sub

Open in new window


Add a macro named RenameSheets and this way you can pass either 15 or whatever you want to append to the sheet names
0
 
NorieCommented:
Can you post the code for appending the worksheets?

Code to change the tab names could br incorporated into that.
0
 
Frank FreeseAuthor Commented:
Code for embedding workbook
Sub Append()
    
    Dim strFileSelected As String
    Dim objOfficeDialog As Object
    Dim wbDestination As Workbook
    Dim wbSource As Workbook
    Dim sh As Worksheet
    
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    Set objOfficeDialog = Application.FileDialog(msoFileDialogFilePicker)
    Set wbDestination = ActiveWorkbook
    
    With objOfficeDialog
        .Title = "Select the Project Cost Allocation file"
        .AllowMultiSelect = False
        If .Show <> -1 Then
            Exit Sub
        End If
        strFileSelected = .SelectedItems(1)
    End With

    If strFileSelected <> "" Then
        Set wbSource = Workbooks.Open(strFileSelected)
        
        For Each sh In wbSource.Sheets
            sh.Copy After:=wbDestination.Worksheets(wbDestination.Worksheets.Count)
        Next
        
        wbSource.Close False
    End If
    
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    MsgBox "Done"
    
End Sub

Open in new window


Randy,
Can we has a message box asking the user to enter a 2 digit year
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
Frank FreeseAuthor Commented:
Randy,
You have 2 subs. Can they be combined into one?
Sub Append()
    
    Dim strFileSelected As String
    Dim objOfficeDialog As Object
    Dim wbDestination As Workbook
    Dim wbSource As Workbook
    Dim sh As Worksheet
    
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    Set objOfficeDialog = Application.FileDialog(msoFileDialogFilePicker)
    Set wbDestination = ActiveWorkbook
    
    With objOfficeDialog
        .Title = "Select the Project Cost Allocation file"
        .AllowMultiSelect = False
        If .Show <> -1 Then
            Exit Sub
        End If
        strFileSelected = .SelectedItems(1)
    End With

    If strFileSelected <> "" Then
        Set wbSource = Workbooks.Open(strFileSelected)
        
        For Each sh In wbSource.Sheets
            sh.Copy After:=wbDestination.Worksheets(wbDestination.Worksheets.Count)
        Next
        
        wbSource.Close False
    End If
    
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    MsgBox "Done"
    
End Sub

Open in new window

0
 
NorieCommented:
Perhaps.
If strFileSelected <> "" Then
        strSuffix = InputBox("Please enter text to append to tab names")
        Set wbSource = Workbooks.Open(strFileSelected)
        
        For Each sh In wbSource.Sheets
            sh.Copy After:=wbDestination.Worksheets(wbDestination.Worksheets.Count)
            wbDestination.Worksheets(wbdestination.Worksheets.Count).Name = sh.Name & " " & strSuffix
        Next sh
        
        wbSource.Close False
    End If

Open in new window

0
 
Frank FreeseAuthor Commented:
imnorie, does this replace what Randy had done?
0
 
Randy PooleCommented:
You would just call hard code the variable:
Sub ChangeTabNames()
    Dim xls As Excel.Worksheet
    Dim sn() As String
    Dim csn As String
    Dim l As Integer
    Dim append as string
    append = InputBox("Please enter a 2 digit year to append to the sheet names")
    append="15"
    append = Trim(append)
    sn = Split("JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC", ",")
    
    For Each xls In ActiveWorkbook.Sheets
        For l = LBound(sn) To UBound(sn)
            If UCase(xls.Name) = sn(l) Then
                xls.Name = xls.Name & " " & append
                Exit For
            End If
        Next l
    Next xls
    
End Sub

Open in new window


Modified for user selection
0
 
NorieCommented:
No, it replaces the section in your code that begins with this,
If strFileSelected <> "" Then
        Set wbSource = Workbooks.Open(strFileSelected)
   

Open in new window

and ends with this.
      wbSource.Close False
    End If
    

Open in new window

0
 
Randy PooleCommented:
remove the append="15" in the last code I put up
0
 
Frank FreeseAuthor Commented:
Randy,
That makes sense
0
 
Frank FreeseAuthor Commented:
well I've got myself confused. What should the module for changing years finally look like, please.
0
 
NorieCommented:
What do you mean by a 'module' changing years?

Both Randy and I have posted code that will rename sheet tabs by appending text input by the user to the existing tab names.
0
 
Frank FreeseAuthor Commented:
Good question, imnorie. Ok...when a new workbook has been added there are  now 12 new tabs at the end of the existing workbook. Each added tab is tabled Sheet1, Sheet2, Sheet3, etc. I would like to change the label of Sheet1 tab to Jan xx where xx is the year, Sheet2 Feb xx, Sheet3 Mar xx, etc.
I'm just so eye weary I'm not sure what module presented will do what I'm ask for so I'm simply requesting the code, regardless if it is yours or Randy. The points will be a 50/50 split.
Thanks for being patient
I hope this helped
0
 
NorieCommented:
You originally said the appended tabs were named 'Jan', 'Feb', 'Mar', etc.

Is that not the case?
0
 
Randy PooleCommented:
originally appended tabs were jan,feb etc, now your saying Sheet 1-12?
0
 
Frank FreeseAuthor Commented:
The appended tabs are labeled Sheet1 - 12. I would like to be able to change their names to Jan 15 - Dec 15 where the only thing the user needs to enter is the 2 digit year. Appending works just fine. Modify the appended tabs to month and 2 digit year is what is need.
I saw where Randy appending works just fine. I am not at a point where the appended tabs are changed from Sheet 1 to Sheet 12 to be Jan 15 to Dec 15 where all the user needed to do was have a input statement that would append to the month
Randy  I tried the code in thread ID: 40195454 but nothing changed?
I've attached the codes. On the Consolidated worksheet is where the form buttons are used. Note the sheets names that have been appended after Dec 14.
Project-Cost-Allocation.xlsm
0
 
Frank FreeseAuthor Commented:
I feel so much like a fool. Randy you code works just fine. I changed the rules and forget I did that. Yo all don't spend anymore time. I am so sorry for wasting every ones time so much on this.
0
 
Frank FreeseAuthor Commented:
I've got some more questions and I hope you'll work with me on them as this project moves forward.
Thank you so much
0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

  • 9
  • 5
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now