excelvbavbe

Adding codes to the newly added tab


I am doing a tracker where I have two main tabs - "Home" and "MasterFile".

"Home" is the tab sheet where they will place the date today in cell B2 (since every month we will be updating this).
"MasterFile" is the template file.

The idea of the tool is to create two new sheets, copying the MasterFile as the new sheets with different filenames - "WFH + (date in B2 cell)"sheet and "MasterFile + (date in B2 cell)"Sheet.

People can edit the "WFH + (date in B2 cell)"sheet. Any changes made will changes the color of the cell as to reference to the "MasterFile + (date in B2 cell)"Sheet.

Example:
Cell B2 value is March 2024. Two new sheet tab will be generated - WFH March 2024 and MasterFile March2024.

How do I input the coding of "worksheet_change" in the newly added tab?
It should be added under "WFH + (date in B2 cell)"sheet every time we add new data.

Option Explicit

Sub NewData()

Dim MasterFileWk As Worksheet

Set MasterFileWk = ThisWorkbook.Sheets("MasterFile")

MasterFileWk.Copy after:=Workbooks("WFH tracker.xlsm").Sheets(Workbooks("WFH tracker.xlsm").Worksheets.Count)

ActiveSheet.Name = "MasterFile " & ThisWorkbook.Sheets("Home").Range("B2")

'second copy
MasterFileWk.Copy after:=Workbooks("WFH tracker.xlsm").Sheets(Workbooks("WFH tracker.xlsm").Worksheets.Count)
ActiveSheet.Name = "WFH " & ThisWorkbook.Sheets("Home").Range("B2")

On Error Resume Next

ThisWorkbook.Sheets("MasterFile " & ThisWorkbook.Sheets("Home").Range("B2")).Protect

End Sub

I am trying to insert the below code in the newly created *"WFH + (date in B2 cell)".

Sub Worksheet_Change(ByVal Target As Range)

    Dim rngCell As Range
    Dim WFHDate As Workbook
'    Set WFHDate = Sheets("Home").Range("B2").Value

    Set rngCell = Sheets("MasterFile " & ThisWorkbook.Sheets("Home").Range("B2").Value).Cells(Target.Row, Target.Column)
    ActiveWindow.ThisWorksheets("WFH " & ThisWorkbook.Sheets("Home").Range("B2")).Select
    If rngCell <> Target Then
        Target.Interior.Color = RGB(181, 244, 0)
    Else
        If rngCell = Target Then
            Target.Interior.Color = RGB(255, 255, 255)
        End If
    End If

End Sub

Solution

  • Hello please try the below code but first make the appropriate reference by going to the visual basic editor -> Tools -> References and checking the box next to: "Microsoft Visual Basic for Applications Extensibility ..."

    Option Explicit
    Sub NewData()
    
    Dim MasterFileWk As Worksheet
    Set MasterFileWk = ThisWorkbook.Sheets("MasterFile")
    
    
    MasterFileWk.Copy after:=Workbooks("WFH tracker.xlsm").Sheets(Workbooks("WFH tracker.xlsm").Worksheets.Count)
    ActiveSheet.Name = "MasterFile " & ThisWorkbook.Sheets("Home").Range("B2")
    
    MasterFileWk.Copy after:=Workbooks("WFH tracker.xlsm").Sheets(Workbooks("WFH tracker.xlsm").Worksheets.Count)
    ActiveSheet.Name = "WFH " & ThisWorkbook.Sheets("Home").Range("B2")
    
    On Error Resume Next
    
    ThisWorkbook.Sheets("MasterFile " & ThisWorkbook.Sheets("Home").Range("B2")).Protect
    
    Dim wb As Workbook
    Dim str As String
    Dim strCodeModuleName As String
    Dim xLine As Long
    
    Set wb = Workbooks("WFH tracker.xlsm")
    str = "WFH " & ThisWorkbook.Sheets("Home").Range("B2")
    strCodeModuleName = wb.Sheets(str).CodeName
    
    With wb.VBProject.VBComponents(strCodeModuleName).CodeModule
    xLine = .CreateEventProc("Change", "Worksheet")
                xLine = xLine + 1
                .InsertLines xLine, "  Dim rngCell As Range"
                xLine = xLine + 1
                .InsertLines xLine, "  Dim WFHDate As Workbook"
                xLine = xLine + 1
                .InsertLines xLine, "  'Set WFHDate = Sheets(""Home"").Range(""B2"").Value"
                xLine = xLine + 1
                xLine = xLine + 1
                .InsertLines xLine, "  Set rngCell = Sheets(""MasterFile "" & ThisWorkbook.Sheets(""Home"").Range(""B2"").Value).Cells(Target.Row, Target.Column)"
                xLine = xLine + 1
                .InsertLines xLine, "  ActiveWindow.ThisWorksheets(""WFH "" & ThisWorkbook.Sheets(""Home"").Range(""B2"")).Select"
                    xLine = xLine + 1
                .InsertLines xLine, "  If rngCell <> Target Then"
                    xLine = xLine + 1
                .InsertLines xLine, "  Target.Interior.Color = RGB(181, 244, 0)"
                    xLine = xLine + 1
                .InsertLines xLine, "Else"
                    xLine = xLine + 1
                .InsertLines xLine, "  If rngCell = Target Then"
                    xLine = xLine + 1
                .InsertLines xLine, "       Target.Interior.Color = RGB(255, 255, 255)"
                    xLine = xLine + 1
                .InsertLines xLine, "  End If"
                    xLine = xLine + 1
                .InsertLines xLine, "End If"
    End With
    
    End Sub
    

    Another option would be to export the the Worksheet_Change module as a .cls file into a shared folder that all users will have access to. Once exported, it will look like this:

    VERSION 1.0 ' delete this line
    BEGIN ' delete this line
      MultiUse = -1 ' delete this line
    END ' delete this line
    Attribute VB_Name = "Sheet1"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = True
    Sub Worksheet_Change(ByVal Target As Range)
    
        Dim rngCell As Range
        Dim WFHDate As Workbook
    '    Set WFHDate = Sheets("Home").Range("B2").Value
    
        Set rngCell = Sheets("MasterFile " & ThisWorkbook.Sheets("Home").Range("B2").Value).Cells(Target.Row, Target.Column)
      ActiveWindow.ThisWorksheets("WFH " & ThisWorkbook.Sheets("Home").Range("B2")).Select
            If rngCell <> Target Then
    
            Target.Interior.Color = RGB(181, 244, 0)
        Else
            If rngCell = Target Then
                Target.Interior.Color = RGB(255, 255, 255)
    
            End If
        End If
    
    End Sub
    

    you will need to delete the first four lines and re-save the .cls file. Next, you can try importing the .cls into the sheet like this:

    Option Explicit
    Sub NewData()
    
    Dim MasterFileWk As Worksheet
    Set MasterFileWk = ThisWorkbook.Sheets("MasterFile")
    
    
    MasterFileWk.Copy after:=Workbooks("WFH tracker.xlsm").Sheets(Workbooks("WFH tracker.xlsm").Worksheets.Count)
    ActiveSheet.Name = "MasterFile " & ThisWorkbook.Sheets("Home").Range("B2")
    
    MasterFileWk.Copy after:=Workbooks("WFH tracker.xlsm").Sheets(Workbooks("WFH tracker.xlsm").Worksheets.Count)
    ActiveSheet.Name = "WFH " & ThisWorkbook.Sheets("Home").Range("B2")
    
    On Error Resume Next
    
    ThisWorkbook.Sheets("MasterFile " & ThisWorkbook.Sheets("Home").Range("B2")).Protect
    
    Dim wb As Workbook
    Dim str As String
    Dim strCodeModuleName As String
    Dim xLine As Long
    
    Set wb = Workbooks("WFH tracker.xlsm")
    str = "WFH " & ThisWorkbook.Sheets("Home").Range("B2")
    strCodeModuleName = wb.Sheets(str).CodeName
    
    With wb.VBProject.VBComponents(strCodeModuleName).CodeModule
    .AddFromFile ("C:\Users\LIUIO\OneDrive - LANXESS Deutschland GmbH\Dokumente\Stack Overflow\Sheet_Change.cls") ' update to your file path
    End With
    
    End Sub