CODEWITHSUNDEEP
vbaexcelworksheet-function
Ovalstar
Ovalstar

Reputation: 1

Issue with calling a procedure from within Workbook_SheetChange

I created a workbook with multiple sheets requiring numerous two-way linked cells in different worksheets within the same workbook. So, if I edit cell B5 in worksheetA, it will automatically update cell J2 in worksheetB with the same value. Conversely, if I update cell J2 in worksheetB, it will automatically update cell B5 in worksheetA. To accomplish the two-way link, I included the following code in ThisWorkbook:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Name = "Smith,Joe" Then
        If Not Application.Intersect(Target, Range("B4")) Is Nothing Then
            Application.EnableEvents = False
            If Target.Parent.Name = "SomeProject" Then
                Sheets("Smith,Joe").Range("B4") = Target
            Else
                Sheets("SomeProject").Range("B10") = Target
            End If
            Application.EnableEvents = True
        End If
    End If
    If Sh.Name = "SomeProject" Then
        If Not Application.Intersect(Target, Range("B10")) Is Nothing Then
            Application.EnableEvents = False
            If Target.Parent.Name = "Smith,Joe" Then
                Sheets("SomeProject").Range("B10") = Target
            Else
                Sheets("Smith,Joe").Range("B4") = Target
            End If
            Application.EnableEvents = True
        End If
    End If
    If Sh.Name = "Smith,Joe" Then
        If Not Application.Intersect(Target, Range("C4")) Is Nothing Then
            Application.EnableEvents = False
            If Target.Parent.Name = "SomeProject" Then
                Sheets("Smith,Joe").Range("C4") = Target
            Else
                Sheets("SomeProject").Range("D10") = Target
            End If
            Application.EnableEvents = True
        End If
    End If
    If Sh.Name = "SomeProject" Then
        If Not Application.Intersect(Target, Range("D10")) Is Nothing Then
            Application.EnableEvents = False
            If Target.Parent.Name = "Smith,Joe" Then
                Sheets("SomeProject").Range("D10") = Target
            Else
                Sheets("Smith,Joe").Range("C4") = Target
            End If
            Application.EnableEvents = True
        End If
    End IF
    'This continues with for many different people/projects
End Sub

This worked without issue until the procedure bumped up against the 64k limit (Found out about that on the forum). To get around the limitation, I created multiple separate procedures called from a main proc, but the cells no longer update automatically. After countless errors and visits to a myriad of forums I've ended up with WorkSheet_Change in ThisWorkbook calling a controlling proc in a module and all of the worksheet and cell references being passed in as variables. It's still no longer updating cells on either worksheet. As it stands right now, I'm getting a Run-time error 91 (Object variable or With block variable not set) when I step through the module code at the ChangeLogic sub.

ThisWorkbook code:

Option Explicit

Public Sh As Object
Public Target As Range
Public ResourceSheet As Object
Public ProjectSheet As Object
Public ResourceCell As String
Public ProjectCell As String

Private Sub Worksheet_Change(ByVal Sh As Object, ByVal Target As Range)

   Run "Main"

End Sub

Code in "Main" module:

Sub Main()

    Call JoeMain

End Sub

Sub JoeMain()

    Set ResourceSheet = Sheets("Smith,Joe")
    Set ProjectSheet = Sheets("SomeProject")

    Call Joe1
    Call ChangeLogic(Sh, Target, ResourceSheet, ProjectSheet, ResourceCell, ProjectCell)

    Call Joe2
    Call ChangeLogic(Sh, Target, ResourceSheet, ProjectSheet, ResourceCell, ProjectCell)

    'Continues on for all cases involing Joe Smith.  I haven't gotten to iterating through project names as of yet

End Sub

Sub Joe1()

    ResourceCell = "B4"
    ProjectCell = "B10"

End Sub

Sub Joe2()

    ResourceCell = "C4"
    ProjectCell = "D10"

End Sub

Sub ChangeLogic(Sh, Target, ResourceSheet, ProjectSheet, ResourceCell, ProjectCell)
    If Sh.Name = ResourceSheet.Name Then
        If Not Application.Intersect(Target, Range(ResourceCell)) Is Nothing Then
            Application.EnableEvents = False
            If Target.Parent.Name = ProjectSheet.Name Then
                Sheets(ResourceSheet.Name).Range(ResourceCell) = Target
            Else
                Sheets(ProjectSheet.Name).Range(ProjectCell) = Target
            End If
            Application.EnableEvents = True
        End If
    End If
    If Sh.Name = ProjectSheet.Name Then
        If Not Application.Intersect(Target, Range(ProjectCell)) Is Nothing Then
            Application.EnableEvents = False
            If Target.Parent.Name = ResourceSheet.Name Then
            Sheets(ProjectSheet.Name).Range(ProjectCell) = Target
            Else
                Sheets(ResourceSheet.Name).Range(ResourceCell) = Target
            End If
            Application.EnableEvents = True
        End If
    End If
End Sub

At this point my newbie colors are showing and I'm in over my head. Any suggestions for what I'm doing wrong and how I can get this to work?

Thanks.

Upvotes: 0

Views: 695

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149295

I was tired of typing in comments so I might as well type here and make it more clear as to what I am saying.

I am not sure how did you reach the 64k limit. As mentioned in the comments above, you can write your code in a more stuctured/compact manner. Currently you code is of 44 lines excluding the Sub/End Sub/Comments The same code can be written in 24 lines

So that is a straight saving of 20 lines!!!.

Imagine how much your final code will reduce to when you remove all the unnecessary Application.EnableEvents/IF-ENDIF

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo Whoa

    Application.EnableEvents = False

    Select Case Sh.Name
    Case "Smith,Joe"
        If Not Application.Intersect(Target, Range("B4")) Is Nothing Then _
        If Target.Parent.Name = "SomeProject" Then Sheets("Smith,Joe").Range("B4") = Target Else _
        Sheets("SomeProject").Range("B10") = Target

        If Not Application.Intersect(Target, Range("C4")) Is Nothing Then _
        If Target.Parent.Name = "SomeProject" Then Sheets("Smith,Joe").Range("C4") = Target Else _
        Sheets("SomeProject").Range("D10") = Target
    Case "SomeProject"
        If Not Application.Intersect(Target, Range("B10")) Is Nothing Then _
        If Target.Parent.Name = "Smith,Joe" Then Sheets("SomeProject").Range("B10") = Target Else _
        Sheets("Smith,Joe").Range("B4") = Target

        If Not Application.Intersect(Target, Range("D10")) Is Nothing Then _
        If Target.Parent.Name = "Smith,Joe" Then Sheets("SomeProject").Range("D10") = Target Else _
        Sheets("Smith,Joe").Range("C4") = Target

        'This continues with for many different people/projects
    End Select
LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Upvotes: 1

Related Questions