0

I writing a VBA code that runs every time a new sheet is added to a workbook and I have hit a snag. This is what I have so far...

Sheet 1 (Job2Date) is a summary of all the sheets that follow. The template already has Week (1) showing. Every sheet that is added the number changes on the sheet name (Week (2), Week (3), Week (4), etc...) There is a hidden sheet that is the template for all new sheets that copies and pastes to the new sheet. Then aA pop up comes up and asks what the first day of that week is and fills in the appropriate sections. In cell "A442" it pastes the sheet name. On the main sheet (Job2Date) it adds new week total columns to the first empty column and fills in the correct dates and week name.

Now the part that I am stuck on is I need to replace all the formulas in the new section with the new sheet name.

Formula: =IF(Week!$G6="","",Week!$G6)

I have this code that works the first time, but the Sheet names are always changing. I need it to replace "Week!" with whatever the new sheet name ("A442" of the new sheet) is and I need it to replace only in the 4 columns that were just added.

Sub Replace()
    
        Sheets("Job2Date").Select
        Range("W12:Z701").Select
        Sheets("Week (2)").Select
        Range("A442").Select
        Selection.Copy
        Sheets("Job2Date").Select
        Selection.Replace What:="Week!", Replacement:="'Week (2)'!", LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False, FormulaVersion:=xlReplaceFor`enter code here`mula2
End Sub

This is my entire code so far.

Private Sub Workbook_NewSheet(ByVal Sh As Object)

    Sheets("Job2Date").Select
    Sheets("Week").Visible = True
    Sheets("Week").Select
    Sheets("Week").Copy After:=Worksheets(Worksheets.Count)
    Sheets("Week").Select
    ActiveWindow.SelectedSheets.Visible = False
    
    Call BlankWorksheets 'This deletes any blank sheets in the workbook
        
    Sheets(Sheets.Count).Select
    
    Dim myValue As Variant
    
'Knowing the first date of the week
myValue = InputBox("What is the start date of this week?", dd, mm, yyyy)
Range("O2").Value = myValue

'Finding new tab name
ActiveSheet.[a442] = ActiveSheet.Name

'Adding a new week onto Job2Date
Select Case Sheets("Job2Date").Range("A1") = ""
Case True
Sheets("Job2Date").Range("O7:R701").Copy Sheets("Job2Date").Range("A7")
Case False
Sheets("Job2Date").Range("O7:R701").Copy Sheets("Job2Date").Range("XFD7").End(xlToLeft).Offset(0, 1)
End Select


'Name of New tab added Job2Date
ActiveSheet.Range("A442").Copy
Sheets("Job2Date").Select
Sheets("Job2Date").Range("XFD9").End(xlToLeft).Offset(, 1).PasteSpecial xlValues
Application.CutCopyMode = False


ActiveCell.Resize(1, 4).Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With

'Adding End Date to Job2Date
Call GoToLast 'This goes to the last sheet that was active
ActiveSheet.Range("AM2").Copy
Sheets("Job2Date").Select
Sheets("Job2Date").Range("XFD10").End(xlToLeft).Offset(, 1).PasteSpecial xlValues
Application.CutCopyMode = False

ActiveCell.Resize(1, 2).Merge


'Go to the Previous Sheet
Call GoToLast

Range("A1").Select

End Sub
BigBen
  • 46,229
  • 7
  • 24
  • 40

1 Answers1

0

There is a lot of missing variable declaration in the workbook which make it quite a challange, especially since the macro get larger and more complex. I strongly advise to read about variable declaration and avoid select.

I also think you can skip several Select statements and if you really need them change them to -> Sheet("Sheet1").Select -> Sheet("Sheet1").Activate.

So to preserve the worksheet name to be able to use it in your "Sub replace" I added Call replace in your main code.

When we create a new sheet, the first thing I do is to take the sheet name and declare it as a public variable which we can use across modules and also refer in the code to the new worksheet and avoid activesheet lines. That worksheet name is then later used to replace Replacement:="'Week (2)'!" -> ThisWorkbook.new_sht_added.

I hope this will get you an idea and some extra lines of code to continue (I have also cleaned up some bits of the code). I think the layout and work with the workbook is really good and easy to follow, so keep up the good work :)!

Link to workbook

Sub Replace()

    Dim Last_Col As Long
    Dim Last_Row As Long
    
    
    'Sheets("Job2Date").Range ("W12:Z701")
    'Sheets("Week (1)").Select
    'Range("A442").Select
    'Selection.Copy
    
    Last_Col = Sheets("Job2Date").Cells(8, Columns.Count).End(xlToLeft).Column 'define the last column for the new range
    Last_Row = Sheets("Job2Date").Cells(Rows.Count, Last_Col - 3).End(xlUp).Row 'define the last row for the new range based on the last column created from Last_Col
    Debug.Print ThisWorkbook.new_sht_added
    
    Sheets("Job2Date").Activate
    ThisWorkbook.Sheets("Job2Date").Range(Sheets("Job2Date").Cells(8, Last_Col - 3), Sheets("Job2Date").Cells(Last_Row, Last_Col)).Select
    
    'https://stackoverflow.com/questions/39402914/replace-reference-to-worksheet-in-a-formula-via-macro
    ThisWorkbook.Sheets("Job2Date").Range(Cells(11, Last_Col - 3), Cells(Last_Row, Last_Col)).Replace What:="Week", Replacement:="'" + ThisWorkbook.new_sht_added + "'", _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub

This is my entire code so far.

Public new_sht_added As String

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Set LstSht = Sh
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
'Sub New_sheet()

    Dim wk_name_Job2Date As Range 'Define the new week name range

    Sheets("Job2Date").Activate                                             '# Changed
    Sheets("Week").Visible = True
    'Sheets("Week").Select                                                  '# Don't think you need this
    
    'Create new worksheet and change the name
    Sheets("Week").Copy After:=Worksheets(Worksheets.Count)
    new_sht_added = ActiveSheet.Name 'We take the name of the new worksheet and store it as a public variable which we can access the new sheet name across sub
    
    'Sheets("Week").Select                                                  '# Don't think you need this
    ' ActiveWindow.SelectedSheets.Visible = False                           ' Think about to set this at a later stage in the code to not disturb or be more specific about what you want to hide, sometimes it causes error I think
    
    Call BlankWorksheets 'This deletes any blank sheets in the workbook
        
    Sheets(Sheets.Count).Select
    
    Dim myValue As Variant
    
'''Knowing the first date of the week'''
myValue = InputBox("What is the start date of this week?", dd, mm, yyyy)
Range("O2").Value = myValue

'''Finding new tab name'''
ActiveSheet.Range("A442").Value = ActiveSheet.Name                          '# Changed this, I didn't get the sheet name with previous line

'''Adding a new week onto Job2Date'''
Select Case Sheets("Job2Date").Range("A1") = ""
Case True
Sheets("Job2Date").Range("O7:R701").Copy Sheets("Job2Date").Range("A7")
Case False
Sheets("Job2Date").Range("O7:R701").Copy Sheets("Job2Date").Range("XFD7").End(xlToLeft).Offset(0, 1)
End Select


'''Name of New tab added Job2Date'''
Sheets(new_sht_added).Range("A442").Copy
Set wk_name_Job2Date = Sheets("Job2Date").Range("XFD8").End(xlToLeft).Offset(1, -3) '# Make the weekname in the sheet "Job2Date" as a range which you can use multiple of times later. I also change the offset to more reliable range

wk_name_Job2Date.PasteSpecial xlValues '# Refer to the defined range and paste as values
Application.CutCopyMode = False


wk_name_Job2Date.Resize(1, 4).Merge '# As we also want to adjust the cell we can again refer to the range
    With wk_name_Job2Date
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With

'''Adding End Date to Job2Date'''
Call GoToLast 'This goes to the last sheet that was active
Sheets(new_sht_added).Range("AM2").Copy
'Sheets("Job2Date").Select                                                          '# Don't think you need this
Sheets("Job2Date").Range("XFD10").End(xlToLeft).Offset(, 1).PasteSpecial xlValues
Application.CutCopyMode = False

ActiveCell.Resize(1, 2).Merge


'''Go to Previous Sheet'''
Call GoToLast

Range("A1").Select


'''Adjust formulas for new sheet'''
Call Replace

End Sub
Wizhi
  • 6,424
  • 4
  • 25
  • 47