Worksheet_Change and Workbook_BeforeSave Issues

richh

Board Regular
Joined
Jun 24, 2007
Messages
245
Office Version
  1. 365
  2. 2016
Hi all,

I have a Worksheet_Change function and a Workbook_BeforeSave function in my master file. When the user selects a specific value in the target field of the worksheet, it will cause the workbook to save. The BeforeSave function kicks in and attempts to send updates to/get updates from a slave file in another directory. For some reason, queuing up the BS function this way causes the second workbook to not open. The BS function seems to work (at least somewhat) fine by itself.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim uAns As Integer
    Dim newA As Variant
    
    If Target.Column = 9 Then
        If  Target.Value = "Reassigned" Then
            uAns = MsgBox("Please ensure that the previously assigned analyst's initials are still on this row before continuing." & _
                " The program will not be able to remove the assignment from their workbook otherwise." & vbNewLine & vbNewLine & _
                "Are you sure you want to continue? You may update the field after this action has completed.", vbYesNo)
            
            If uAns = vbYes Then
                Dim good2go As Boolean
                good2go = False
                
                Target.Offset(0, 11) = "RE" 
                ThisWorkbook.Save 'Error occurs here****************************************************
                
                Do Until good2go = True
                    newA = InputBox("The assignment has been removed from the previous analyst. Please enter the initials of the new analyst to whom you want to assign this task.")
                
                    If UCase(CStr(newA)) <> "AA" Or UCase(newA) <> "BB" Or UCase(newA) <> "CC" Or UCase(newA) <> "DD" Or UCase(newA) <> "EE" Or UCase(newA) <> "FF" Then
                        MsgBox "ERROR. Enter the initials of one of the analysts."
                    Else
                        good2go = True
                    End If
                Loop
                
                Target.Offset(0, -2) = newA
                Target.Offset(0, 11) = "New"
                
                ThisWorkbook.Save 'Will then reassign to new analyst
                
                MsgBox "Reassignment complete."
            Else
                Exit Sub
            End If
        End If
    End If

End Sub
********************************
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim wb      As Workbook
    Dim wb2     As Workbook
    Dim ws      As Worksheet
    Dim ws2     As Worksheet
    Dim lRow    As Integer
    Dim lRow2   As Integer
    Dim path    As String
    Dim fName   As String
    Dim fullP   As String
    Dim aName   As String
    Dim uDates  As Integer
    Dim cRng    As Range
    Dim dRng    As Range
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("FY 18-19")
    
    path = "path"
    fName = Dir(path & "\*.xlsm", vbNormal)
    
    If Len(fName) = 0 Then Exit Sub
   
    Do Until fName = ""
        fullP = path & "\" & fName
        Set wb2 = Workbooks.Open(fullP) 'Error occurs here *********************************************
        Set ws2 = wb2.Worksheets("FY 18-19")
        
        lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
        lRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
        
        aName = Mid(fName, 7, 2)
        
        
        For i = 2 To lRow 'send new assignments to analyst
            If ws.Cells(i, 7).Value = aName Then
                If ws.Cells(i, 20) = "New" Then
                    Set cRng = ws.Range("A" & i & ":T" & i)
                    Set dRng = ws2.Range("A" & lRow2 + 1 & ":T" & lRow2 + 1)
                    dRng.Value = cRng.Value 'copy/paste new assignment in analyst's file
                    lRow2 = lRow2 + 1 'move to the next row
                    ws.Cells(i, 20) = "No Change" 'change the flag in master file
                ElseIf ws.Cells(i, 20) = "RE" Then 'when the task has been reassigned...
                    For m = 2 To lRow
                        If ws2.Cells(m, 6) = ws.Cells(i, 6) And _
                        ws2.Cells(m, 7) = ws.Cells(i, 7) And _
                        ws2.Cells(m, 8) = ws.Cells(i, 8) Then
                            ws2.Rows(m).EntireRow.Delete 'check to ensure that the key fields match and then delete the assignment in the analyst's file
                            Exit For
                        End If
                    Next m
                End If
            End If
        Next i
        
        For j = 2 To lRow2 'check for updates from analyst
            If ws2.Cells(j, 20).Value <> "New" And ws2.Cells(j, 20).Value <> "No Change" Then
                For K = 2 To lRow
                    If ws.Cells(K, 20) <> "Completed" Then
                        If ws.Cells(K, 6).Value = ws2.Cells(j, 6).Value And _
                            ws.Cells(K, 7).Value = ws2.Cells(j, 7).Value And _
                            ws.Cells(K, 8).Value = ws2.Cells(j, 8).Value Then
                                Set cRng = ws2.Range("A" & j & ":T" & j)
                                Set dRng = ws.Range("A" & K & ":T" & K)
                                dRng.Value = cRng.Value 'check key fields and then update corresponding row in master
                            If ws2.Cells(j, 20).Value <> "Completed" Then
                                ws2.Cells(j, 20).Value = "No Change"
                            End If
                        End If
                    End If
                Next K
            End If
        Next j
    
    wb2.Close savechanges:=True
    fName = Dir()
    Loop
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
        
        
End Sub


Another issue I keep getting is that if I stop the debugger in any one of these functions causes them to no longer work at all until I completely close all Excel windows and start up again. Is there any way I can get these to start back up without abandoning ship?
 
Last edited:

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Hi all,

I have a Worksheet_Change function and a Workbook_BeforeSave function in my master file. When the user selects a specific value in the target field of the worksheet, it will cause the workbook to save. The BeforeSave function kicks in and attempts to send updates to/get updates from a slave file in another directory. For some reason, queuing up the BS function this way causes the second workbook to not open. The BS function seems to work (at least somewhat) fine by itself.

Another issue I keep getting is that if I stop the debugger in any one of these functions causes them to no longer work at all until I completely close all Excel windows and start up again. Is there any way I can get these to start back up without abandoning ship?
At least one of your event codes disables events. So, if you stop the code when an error occurs you will have to turn events back on before any event macro will trigger again. The easy way to do this is to open the VBE (press alt+F11 keys), press ctrl+g to open the Immediate Window, then in that window type (w/o the quote marks) "Application.EnableEvents = True" and press enter.

Can you tell us what error(s) you get at the points in your code where you have indicated the error occurs?
 
Upvote 0
Wow, that immediate window thing is the bee's knees! Thanks for that!

The error I get is "Run time error '91': Object variable or With block variable not set."

I don't get this error when the BS function is ran by itself. saving via the WS_Change func won't open the workbook that is found via the fullP string.
 
Upvote 0
Hi all,

I have a Worksheet_Change function and a Workbook_BeforeSave function in my master file. When the user selects a specific value in the target field of the worksheet, it will cause the workbook to save. The BeforeSave function kicks in and attempts to send updates to/get updates from a slave file in another directory. For some reason, queuing up the BS function this way causes the second workbook to not open. The BS function seems to work (at least somewhat) fine by itself.

Wow, that immediate window thing is the bee's knees! Thanks for that!

The error I get is "Run time error '91': Object variable or With block variable not set."

I don't get this error when the BS function is ran by itself. saving via the WS_Change func won't open the workbook that is found via the fullP string.
You are welcome.

Looking at your code for BS, it's hard to believe that the full path to the workbook you want to open begins with "path". If that's not really part of the path then this bit:

path = "path"
fName = Dir(path & "\*.xlsm", vbNormal)

If Len(fName) = 0 Then Exit Sub

Do Until fName = ""
fullP = path & "" & fName
Set wb2 = Workbooks.Open(fullP)

would cause a runtime error as the file can't be found.


 
Upvote 0
You are welcome.

Looking at your code for BS, it's hard to believe that the full path to the workbook you want to open begins with "path". If that's not really part of the path then this bit:

path = "path"
fName = Dir(path & "\*.xlsm", vbNormal)

If Len(fName) = 0 Then Exit Sub

Do Until fName = ""
fullP = path & "" & fName
Set wb2 = Workbooks.Open(fullP)

would cause a runtime error as the file can't be found.



That portion of the code is not really "path" in my program; it accesses a real directory. I could use "path = ThisWorkbook.Path & "" & "mySubDir", but as I have no intention of moving the directory is attempting to access, I have a static address in there.

fullP technically equates to thiswork.path & "" & "mySubDir" & "" & fName (fName is the name of my file including ".xlsm")

blank spaces are backslashes btw

The loop changes the file name it's looking at.

again, this works when BS is ran by itself. saving it from the worksheet function.
 
Last edited:
Upvote 0
Thanks for clarifying that. Assuming you included a path separator in there (like thiswork.path & "" & "mySubDir" & "\" & fName), I'm afraid I'm not able to see why you get an error when the change event triggers the BS event.
 
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,259
Members
452,626
Latest member
huntinghunter

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