Workbook_SheetChange event loses reference to Workbook

Tim_Excel_

Tim_Excel_

Well-known Member
Joined
Jul 12, 2016
Messages
512
Hi forum,

I have a Workbook_SheetChange event for another workbook (other than the workbook that holds the code). At the end of a lengthy Sub, I call for the Sub that defines the Workbook's name that the event needs to work for:

Code: 
Sub step1()

'''''code''''

NameGrabber.DefineWorkbookName

End Sub

Code: 
Dim oWb As New Updater

Sub DefineWorkbookName()
Application.EnableEvents = True
Dim AddNew As Workbook
    Set AddNew = Workbooks("test1")
    Set oWb.Workbook = AddNew


End Sub

Then, in a Class Module sits the Workbook_Sheetchange event:
Code: 
Public WithEvents m_wb As Workbook

Public Property Set Workbook(wb As Workbook)
    Set m_wb = wb
End Property


Public Property Get Workbook() As Workbook
    Set Workbook = m_wb
End Property

Public Sub m_wb_SheetChange(ByVal Sh As Object, ByVal Target As Range)

''''code''''

End Sub

Problem is, the SheetChange event will only run if I manually run the DefineWorkbookName Sub myself first, even though the code is set to run (and does run) through this sub already.

Is there any way I could have the SheetChange event run without having to run the DefineWorkbookName sub manually first? Thanks a lot!
 
Sort by date Sort by votes
The reason I say that is because the WorksheetChange event doesn't get executed (so the code has no effect) and the code before the DefineWorkbookName is called has already passed, so this would logically sit idle as well. Regardless, here is the code:
Code: 
 'Maakt nieuwe formule aan om te kijken of sheet al bestaat
 Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
    Dim sht As Worksheet
    'bestand = UserForm1.ComboBox1.Value
    bestand = "test1"


     Set wb = Workbooks(bestand)
     On Error Resume Next
     Set sht = wb.Sheets(shtName)
     On Error GoTo 0
     SheetExists = Not sht Is Nothing
 End Function
Sub stap1()
Application.EnableEvents = False


'bestand = UserForm1.ComboBox1.Value
bestand = "test1"


With Workbooks(bestand)




'nieuwe WS aannmaken, als sheet niet al bestaat. Zowel, voeg nummer toe
Dim csheet As String
If SheetExists("Componenten") = False Then
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Componenten"
    csheet = "Componenten"
    Else
        For i = 2 To 15
            If SheetExists("Componenten" & i) = False Then
                .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Componenten" & i
                csheet = "Componenten" & i
                Exit For
            End If
        Next i
End If
        


        
'Kopiëer bovenste kolom van sheet 1
LCol = ThisWorkbook.Sheets(1).Rows("72:72").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column


ThisWorkbook.Sheets(1).Range(ThisWorkbook.Sheets(1).Cells(72, 11), ThisWorkbook.Sheets(1).Cells(72, LCol)).Copy
.Sheets(csheet).Range(.Sheets(csheet).Cells(1, 1), .Sheets(csheet).Cells(1, LCol)).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
                 Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Sheets(csheet).Rows(1).AutoFilter


'Zoeken naar eerste "Originals" in Code kolom
Set CodeCol = .Sheets(1).Range("A1:L1").Find("Code")
Origcell = .Sheets(1).Columns(CodeCol.Column).Find("Original*").Row


'kopiëren van kolommen vanaf OrigCell row
.Sheets(1).Range(.Sheets(1).Cells(Origcell, CodeCol.Column).Offset(0, -1), .Sheets(1).Cells(Origcell, CodeCol.Column).Offset(.Sheets(1).Cells(.Sheets(1).Rows.Count, CodeCol.Column).End(xlUp).Row, 0)).Copy
.Sheets(csheet).Paste (.Sheets(csheet).Range("A2")) 'Tree level & Code
.Sheets(1).Range(.Sheets(1).Cells(Origcell, CodeCol.Column).Offset(0, 2), .Sheets(1).Cells(Origcell, CodeCol.Column).Offset(.Sheets(1).Cells(.Sheets(1).Rows.Count, CodeCol.Column).End(xlUp).Row, 2)).Copy
.Sheets(csheet).Paste (.Sheets(csheet).Range("D2")) 'Stock Item Commodity Code
.Sheets(1).Range(.Sheets(1).Cells(Origcell, CodeCol.Column).Offset(0, 6), .Sheets(1).Cells(Origcell, CodeCol.Column).Offset(.Sheets(1).Cells(.Sheets(1).Rows.Count, CodeCol.Column).End(xlUp).Row, 6)).Copy
.Sheets(csheet).Paste (.Sheets(csheet).Range("H2")) 'Description
.Sheets(1).Range(.Sheets(1).Cells(Origcell, CodeCol.Column).Offset(0, 9), .Sheets(1).Cells(Origcell, CodeCol.Column).Offset(.Sheets(1).Cells(.Sheets(1).Rows.Count, CodeCol.Column).End(xlUp).Row, 9)).Copy
.Sheets(csheet).Paste (.Sheets(csheet).Range("I2")) 'Stock Item Description
.Sheets(1).Range(.Sheets(1).Cells(Origcell, CodeCol.Column).Offset(0, 4), .Sheets(1).Cells(Origcell, CodeCol.Column).Offset(.Sheets(1).Cells(.Sheets(1).Rows.Count, CodeCol.Column).End(xlUp).Row, 4)).Copy
.Sheets(csheet).Paste (.Sheets(csheet).Range("F2")) 'Quantity
.Sheets(1).Range(.Sheets(1).Cells(Origcell, CodeCol.Column).Offset(0, 1), .Sheets(1).Cells(Origcell, CodeCol.Column).Offset(.Sheets(1).Cells(.Sheets(1).Rows.Count, CodeCol.Column).End(xlUp).Row, 1)).Copy
.Sheets(csheet).Paste (.Sheets(csheet).Range("C2")) 'Specification
.Sheets(1).Range(.Sheets(1).Cells(Origcell, CodeCol.Column).Offset(0, 5), .Sheets(1).Cells(Origcell, CodeCol.Column).Offset(.Sheets(1).Cells(.Sheets(1).Rows.Count, CodeCol.Column).End(xlUp).Row, 5)).Copy
.Sheets(csheet).Paste (.Sheets(csheet).Range("G2")) 'posnr
.Sheets(1).Range(.Sheets(1).Cells(Origcell, CodeCol.Column).Offset(0, 10), .Sheets(1).Cells(Origcell, CodeCol.Column).Offset(.Sheets(1).Cells(.Sheets(1).Rows.Count, CodeCol.Column).End(xlUp).Row, 10)).Copy
.Sheets(csheet).Paste (.Sheets(csheet).Range("K2")) 'Parent Component Code
.Sheets(1).Range(.Sheets(1).Cells(Origcell, CodeCol.Column).Offset(0, 3), .Sheets(1).Cells(Origcell, CodeCol.Column).Offset(.Sheets(1).Cells(.Sheets(1).Rows.Count, CodeCol.Column).End(xlUp).Row, 3)).Copy
.Sheets(csheet).Paste (.Sheets(csheet).Range("E2")) 'Category Code


LRow = .Sheets(csheet).Cells(.Sheets(csheet).Rows.Count, "B").End(xlUp).Row
LCol = .Sheets(csheet).Cells(1, .Sheets(csheet).Columns.Count).End(xlToLeft).Column


'invoeren formules kolommen J-N
.Sheets(csheet).Range("J2:J" & LRow).FormulaR1C1 = _
        "=CONCATENATE(RC[-3],"" - "",RC[-1],"" ("",RC[-6],"")"")"
.Sheets(csheet).Range("L2:L" & LRow).FormulaR1C1 = _
        "=IF(RC[1]<>"""",R[-1]C,CONCATENATE(RC[-1],""_"",VLOOKUP(RC[-1],C[-10]:C[-9],2,0)))"
.Sheets(csheet).Range("M2:M" & LRow).FormulaR1C1 = _
        "=IFERROR(IFS(AND(NOT(RC[-8]=""""),RC[-11]=R[1]C[-2]),"""",LOOKUP(2,1/(R[-30]C[-2]:R[-1]C[-2]<>RC[-2]),R[-30]C[-8]:R[-1]C[-8])<>""SA-NP"","""",IFERROR(LOOKUP(2,1/(R[-30]C[-2]:R[-1]C[-2]<>RC[-2]),R[-30]C[-1]:R[-1]C[-1]),"""")<>"""",RC[-2]),"""")"
.Sheets(csheet).Range("N2:N" & LRow).FormulaR1C1 = _
        "=IF(AND(R[1]C[-13]>RC[-13],RC[-10]=R[1]C[-10]),VLOOKUP(RC[-3],C[-12]:C[-8],5,0)*RC[-8],VLOOKUP(RC[-3],C[-12]:C,13,0)*RC[-8])"






'Kleuren, randjes kolommen
For Each Column In Range(.Sheets(csheet).Cells(1, 15), .Sheets(csheet).Cells(1, LCol))
    If Column.Column Mod 2 = 1 Then
        .Sheets(csheet).Columns(Column.Column).Interior.PatternColorIndex = xlAutomatic
        .Sheets(csheet).Columns(Column.Column).Interior.ThemeColor = xlThemeColorDark1
        .Sheets(csheet).Columns(Column.Column).Interior.TintAndShade = -4.99893185216834E-02
        .Sheets(csheet).Columns(Column.Column).Interior.PatternTintAndShade = 0
End If
Next




        .Sheets(csheet).Columns("N:N").Interior.PatternColorIndex = xlAutomatic
       .Sheets(csheet).Columns("N:N").Interior.ThemeColor = xlThemeColorAccent2
    .Sheets(csheet).Columns("N:N").Interior.TintAndShade = 0.799981688894314
.Sheets(csheet).Columns("N:N").Interior.PatternTintAndShade = 0
.Sheets(csheet).Activate
    .Sheets(csheet).Range(.Sheets(csheet).Cells(1, 14), .Sheets(csheet).Cells(LRow, LCol)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With




    With .Sheets(csheet).Range(Cells(2, 1), Cells(LRow, LCol))
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=AND($A2=3,$D2=""SA"")"
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=AND($A2=4,$D2=""SA"")"
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=AND($A2=5,$D2=""SA"")"
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=AND($A2=6,$D2=""SA"")"
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=AND($A2=7,$D2=""SA"")"
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
          "=AND($A2=8,$D2=""SA"")"
        With .FormatConditions(1)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .Color = RGB(252, 228, 214)
                .TintAndShade = 0
            End With
        End With
        With .FormatConditions(2)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .Color = RGB(226, 239, 218)
                .TintAndShade = 0
            End With
        End With
        With .FormatConditions(3)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .Color = RGB(217, 225, 242)
                .TintAndShade = 0
            End With
        End With
        With .FormatConditions(4)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .Color = RGB(255, 242, 204)
                .TintAndShade = 0
            End With
        End With
        With .FormatConditions(5)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .Color = RGB(255, 204, 255)
                .TintAndShade = 0
            End With
        End With
        With .FormatConditions(6)
            .SetFirstPriority
            With .Interior
                .PatternColorIndex = xlAutomatic
                .Color = RGB(153, 255, 102)
                .TintAndShade = 0
            End With
        End With
    End With






'Bovenste rij scrollt mee, kolombreedte aangepast, bovenste rij verticale tekst
    With .Sheets(csheet).Rows("1:1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 90
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With


.Sheets(csheet).Activate
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True
Columns("B:M").EntireColumn.AutoFit
Columns("A").ColumnWidth = 3.3
Columns("G").ColumnWidth = 2
Columns("I").ColumnWidth = 40
Columns("J").ColumnWidth = 50
Columns("N").ColumnWidth = 7.5
Columns(15).Resize(, LCol).ColumnWidth = 3.6


'>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
'>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
''''''''''''''''''''GELE SHEET''''''''''''''''''''''
'>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<'
'>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<'




'nieuwe WS aannmaken, als sheet niet al bestaat. Zowel, voeg nummer toe
Dim gsheet As String
If SheetExists("AssetTypeTask") = False Then
    .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "AssetTypeTask"
    gsheet = "AssetTypeTask"
    Else
        For i = 2 To 15
            If SheetExists("AssetTypeTask" & i) = False Then
                .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "AssetTypeTask" & i
                gsheet = "AssetTypeTask" & i
                Exit For
            End If
        Next i
End If




'Rijen voor nieuwe sheet kopiëren plakken
LCol = ThisWorkbook.Sheets(1).Cells(70, ThisWorkbook.Sheets(1).Columns.Count).End(xlToLeft).Column


ThisWorkbook.Sheets(1).Range(ThisWorkbook.Sheets(1).Cells(70, 11), ThisWorkbook.Sheets(1).Cells(70, LCol)).Copy
Workbooks(bestand).Sheets(gsheet).Paste




'bovenste rij scrollt mee, autofilter en kolombreedte
.Sheets(gsheet).Columns("A:AU").EntireColumn.AutoFit
.Sheets(gsheet).Columns("B:B").ColumnWidth = 28
.Sheets(gsheet).Columns("D:D").ColumnWidth = 42
.Sheets(gsheet).Columns("E:E").ColumnWidth = 42
.Sheets(gsheet).Rows(1).AutoFilter
.Sheets(gsheet).Activate
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True


End With




NameGrabber.DefineWorkbookName


End Sub
Code: 
Dim oWb As New Updater


Sub DefineWorkbookName()
Application.EnableEvents = True
Dim AddNew As Workbook
    Set AddNew = Workbooks("test1")
    Set oWb.Workbook = AddNew


End Sub
Code: 
Public WithEvents m_wb As Workbook


Public Property Set Workbook(wb As Workbook)
    Set m_wb = wb
End Property


Public Property Get Workbook() As Workbook
    Set Workbook = m_wb
End Property
Public Sub m_wb_SheetChange(ByVal Sh As Object, ByVal Target As Range)




'Dynamische referentie
If Not Sh.Name = "Componenten" Then Exit Sub
If Intersect(Target, Worksheets("Componenten").Range("O2:BG500")) Is Nothing Then Exit Sub


    Application.EnableEvents = False
Dim cell As Range
For Each cell In Target
    Header = Cells(1, cell.Column).Value
    Dim rng1 As Range
    Set rng1 = ThisWorkbook.Sheets(1).Range("A:A").Find(Header, , xlValues, xlWhole)
    LRow = m_wb.Sheets("AssetTypeTask").Cells(m_wb.Sheets("AssetTypeTask").Rows.Count, "B").End(xlUp).Row + 1
    
    'Als er een getal weg wordt gehaald
    If cell.Value = "" And Not rng1 Is Nothing Then


            Dim FindString As String
            Dim Rng As Range
            FindString = Cells(cell.Row, 2) & "_" & rng1.Offset(0, 1)
            With m_wb.Sheets("AssetTypeTask").Range("B:B")
            Set searchtodelete = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            End With
                 If searchtodelete Is Nothing Then GoTo ncell


        m_wb.Sheets("AssetTypeTask").Rows(searchtodelete.Row).EntireRow.Delete
        
    'Als er een getal bij wordt gezet
    ElseIf Not rng1 Is Nothing Then
    
        'aanpassen van waarde ingevuld met de waarde uit kolom O
        cell.Value = Range("N" & cell.Row).Value
        
        'vullen van alle cellen in rij met correcte data op basis van de kolom header waar een nummer is ingevuld
            If rng1.Offset(0, 4) <> "" Then PValue = "DAYS" Else PValue = "ADHOC"
            If rng1.Offset(0, 5) = "PREVENTIVE" Or rng1.Offset(0, 5) = "REACTIVE" Then AGValue = "MEYN-OOST" Else AGValue = "CUSTOMER"
            If rng1.Offset(0, 5) = "PREVENTIVE" Or rng1.Offset(0, 5) = "REACTIVE" Then AHValue = "EU-SERV-ENG-M" Else AHValue = "CUST-MECH"
            
            Dim RArray As Variant
            RArray = Array("M", Cells(cell.Row, 2) & "_" & rng1.Offset(0, 1), "", Cells(cell.Row, 9) & rng1.Offset(0, 2), Cells(cell.Row, 9) & rng1.Offset(0, 2), _
                "", "0", rng1.Offset(0, 3), "1", "?", "?", "0", rng1.Offset(0, 4), "", "NORM", PValue, "0", "0", "0", "", "0", "0", "0", "0", "1", "1", "1", "0", "0", "", "", rng1.Offset(0, 5), AGValue, AHValue, _
                "UNKNOWN", "", "UNKNOWN", "UNKNOWN", "UNKNOWN", "UNKNOWN", "UNKNOWN", "UNKNOWN", "UNKNOWN", "UNKNOWN")
        
            m_wb.Sheets("AssetTypeTask").Range("A" & LRow & ":AR" & LRow) = RArray
            


    End If
    
ncell:
Next cell


Application.EnableEvents = True
End Sub

EDIT: since I am logging off of work, I will be back tomorrow.
 
Last edited:
Upvote 0

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
My point is that if running the same code manually does work, then there is something in the code that runs this code that causes it not to work. What is Namegrabber? A userform?
 
Upvote 0
Fair point Rory!

Namegrabber is a regular Module in my workbook which holds DefineWorkbookName, the other module is Module1. The class module is called Updater.
 
Upvote 0
I have done some testing and noticed that when firing off the entire code manually, the Change event DOES work. When using the ActiveX button, this is not the case. This button launches a userform that let's the user choose from the list of open workbooks that will be edited using VBA. I suspect this is in some way causing the Change event to not work. The code from the Userform:

Code: 
Public bestand As String

Public Sub ComboBox1_Change()
bestand = ComboBox1.Value
End Sub




Public Sub OKButton_Click()
bestand = ComboBox1.Value


If bestand = "" Or bestand = "Kies een bestand" Then
wrning = MsgBox("Kies eerst een bestand", vbOKOnly, "Fout")
Exit Sub
Else
    stap1
    Unload Me
End If
End Sub
Private Sub UserForm_Initialize()
Dim wb As Workbook
bestand = ""
    With Me.ComboBox1
        For Each wb In Application.Workbooks
        If Not wb.Name = ThisWorkbook.Name Then
            .AddItem wb.Name
        End If
        Next wb
    End With
        
End Sub
Private Sub CommandButton2_Click()
End
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
End
End Sub

in which variable "bestand" is the open workbook that the user has selected from the combobox. This variable is used in the other modules as well.
 
Upvote 0
End would clear any public variables. Why are you using it?
 
Upvote 0
Thank you so much Rory! That was what causing the loss of variable. DefineWorkbookName would run as the last piece of code, then the userform would unload and this would cause Sub UserForm_QueryClose to fire off the End command. I have constructed this UserForm over a year ago when I was more of a novice in VBA and therefore I don't have a good reason for using End instead of Unload Me.

Anyway, all works now. Thanks a bunch.
 
Upvote 0
In QueryClose you don't even need Unload Me since the form is already unloading if that event fires. ;)
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
VBA Populate userform dynamically with custom class Frame
Replies
1
Views
371
saboh12617
S
J
  • Question Question
Augmenting VBA to Refresh Specific before All Power Queries
Replies
2
Views
433
johnny51981
J
D
  • Solved
Class Module to include one decimal place in userform textboxes
Replies
3
Views
78
dlee83
D
R
  • Solved
Worksheet CodeName as type Worksheet
Replies
7
Views
514
StephenCrump
S
A
  • Question Question
VBA Class Module: Should it be a property?
Replies
3
Views
788
Artik
Artik

Forum statistics

Threads
1,223,921
Messages
6,175,379
Members
452,639
Latest member
RMH2024

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top