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