1

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
Improve this question
2
  • In a worksheet code module you can use Me to refer to the associated worksheet. I'm not really sure what's going on in that Change event though. Commented Mar 1, 2024 at 17:44
  • Thanks @TimWilliams will take a look at that and research more about that Commented Mar 2, 2024 at 11:12

1 Answer 1

Reset to default
1

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
Improve this answer
Sign up to request clarification or add additional context in comments.

6 Comments

Thank you so much, i get the idea however for some reason the code won't work/ not copied in the added new sheet tab. I appreciate this though cause it is a good start for me to explore and tweak. Thank you!
Hi Jen, if you explain which section of the code is not working, I'd be happy to assist with adjusting it! Question, are you working in 2 different workbooks? Or is "WFH tracker.xlsm" the only workbook that is open/ the source wb?
Also, did you enable the reference for Extensibility? That is crucial.
Ive updated my answer with another option for importing the code. Please let me know if you have any questions or need help.
Thank you Kurt. My apologies for just getting back due to personal reason. The code work after I added the reference for extensibility. Thank you so much for the patience and help. Kudos to you
|

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.