Cancelling a sub from running so data doesn't get deleted

[dpaton05]

I have 2 buttons to copy data from the current workbook to another. One button copies and leaves the data there. The other button copies and deletes the data.

The files are on a network and if the second workbook is already open I have code that notifies the user trying to open the file and asks them to wait or contact the person who has it open.

The issue is that if the file is already open the user is asked to try again later but if they selected the button to copy the data and delete the contents, the contents will be gone and they won't be able to try again later as the data won't be there.

I have a rather lengthy sub to copy the data as there are many processes that need to be run.

This is the code for my copy and delete contents button:

Sub cmdCopyLineBlank_Click()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Costing_tool")

    ws.Unprotect
        Call cmdCopy
    ws.Unprotect
        Call CostingDeleteAll
  '  ws.Protect

End Sub

and this code is from the second workbook

Sub Workbook_Open()

Application.WindowState = xlMaximized

Dim file1 As Integer
Dim strLine As String
file1 = FreeFile
    If Not ActiveWorkbook.ReadOnly = True Then
        'only add name to the usage log if the user has it locked
        Open ThisWorkbook.Path & "\usage.log" For Append As #file1
        Print #file1, Environ("USERNAME") & ". Please close all the additional workbooks that will be opened " _
        & " WITHOUT SAVING THEM. Then contact the user that has it open or wait until they are finished."
        Close #file1
    Else
        'if someone else has the file open, find out who
        Open ThisWorkbook.Path & "\usage.log" For Input Access Read As #file1
            Do While Not EOF(file1)
               Line Input #file1, strLine
            Loop
        Close #file1
        MsgBox "The following user has the allocation sheets open: " & strLine
    End If


'Worksheets("home").Protect Password:="costings"

End Sub

Part of cmdCopy calls the second workbook to open but if it is already open by someone else, how do I force it to skip the line of code?

Call CostingDeleteAll

 

[dpaton05]

I have just realised, I have a sort sub and I just tried to run it and it wouldn't run. There was a

SafeToDelete = True

after the line

end sub

It didn't look right but I couldn't remember if I needed to have it there or not?

 

[dpaton05]

I never did get your suggestion implemented as I got busy when you replied but things are quieter now so I am just trying to work it out.

I am trying to follow your instructions but I am getting a bit lost. I have renamed the variable to UnsafeToDelete to make is make more sense to me.

This is my open code from the workbook that I want the code to look and see if it is open.

Sub Workbook_Open()

Application.WindowState = xlMaximized

Dim file1 As Integer
Dim strLine As String
file1 = FreeFile
    If Not ActiveWorkbook.ReadOnly = True Then
        'only add name to the usage log if the user has it locked
        Open ThisWorkbook.Path & "\usage.log" For Append As #file1
        Print #file1, Environ("USERNAME") & ". Please close any allocation sheets that has been opened" _
        & " WITHOUT SAVING THEM. Then contact the user that has it open or wait until they are finished."
        Close #file1
        
    Else
        'if someone else has the file open, find out who
        Open ThisWorkbook.Path & "\usage.log" For Input Access Read As #file1
            Do While Not EOF(file1)
               Line Input #file1, strLine
            Loop
        Close #file1
        'Assign true to the UnsafeToDelete variable to identify someone has it open
        UnsafeToDelete = True
        MsgBox "The following user has the allocation sheets open: " & strLine
        'If UnsafeToDelete is true, a user has the allocation sheet open, so exit sub
        If UnsafeToDelete = True Then UnsafeToDelete = False: Exit Sub
    End If


'Worksheets("home").Protect Password:="costings"

End Sub

This is the code from the button that copies and clears the lines. The one where I want it to not clear the lines if it is already open

Sub cmdCopyLineBlank_Click()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Costing_tool")

    ws.Unprotect
        Call cmdCopy
        If UnsafeToDelete = True Then UnsafeToDelete = False: Exit Sub

    ws.Unprotect
        Call CostingDeleteAll
  '  ws.Protect

End Sub

In the same workbook, this is at the top of module 1

Option Explicit
Public UnsafeToDelete As Boolean

It seems to work but it still opens the additional sheets
I have included the code for cmdCopy so you can see where the additional sheets are opened.

       Sub cmdCopy()
'On Error GoTo ErrorMsg
Dim wsDst As Worksheet, wsHours As Worksheet, wsTrack As Worksheet, worker As String, wsSrc As Worksheet, tblrow As ListRow
Dim Combo As String, sht As Worksheet, tbl As ListObject
Dim LastRow As Long, DocYearName As String, Site As String, lr As Long, HoursRow As Long
Dim RowColor As Long, w As Window, r As Long, HoursRegister As String, ReportTracking As String
Application.ScreenUpdating = False

'assign values to variables
Set tbl = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting")
Set sht = ThisWorkbook.Worksheets("Costing_tool")
Site = ThisWorkbook.Worksheets("Start_here").Range("H9").Value
'Check if each row has a date, service and requesting organisation
For Each tblrow In tbl.ListRows
If tblrow.Range.Cells(1, 1).Value = "" Or tblrow.Range.Cells(1, 5).Value = "" Or tblrow.Range.Cells(1, 6).Value = "" Then
MsgBox "The Date, Service or Requesting Organisation has not been entered for every record in the table"
Exit Sub
End If
Next tblrow
For Each tblrow In tbl.ListRows
'Define combo as the month to be recorded in
Combo = tblrow.Range.Cells(1, 26).Value
'If column 8 for the row is blank...
If Not tblrow.Range(1, 8).Value = "" Then
'worker variable is defined as the value in column 8 of the row
worker = tblrow.Range.Cells(1, 8).Value
Else
'otherwise, "not allocated" is assigned to the worker variable.
'this is used in the hours register to identify which sheet to place the hours in
worker = "Not allocated"
End If
'defines HoursRegister as the hours register filename that is stored in column 38 for the row
'HoursRegister = tblrow.Range.Cells(1, 38)
'defines ReportTracking as the report tracking filename that is stored in column 39 for the row
ReportTracking = tblrow.Range.Cells(1, 39)
Select Case Site
Case "Wes"
Select Case tblrow.Range.Cells(1, 6).Value
Case "Ang Wes", "Ang Wa", "Ang Al", "Ang SC", "Yiri"
DocYearName = tblrow.Range.Cells(1, 37).Value
Case Else
DocYearName = tblrow.Range.Cells(1, 36).Value
End Select
Case "Riv"
Select Case tblrow.Range.Cells(1, 6).Value
Case "Ang Wes", "Ang Wa", "Ang Al", "Ang SC", "Yiri"
DocYearName = tblrow.Range.Cells(1, 42).Value
Case Else
DocYearName = tblrow.Range.Cells(1, 36).Value
End Select

End Select
If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Work Allocation Sheets" & "\" & Site & "\" & DocYearName & ".xlsm"
'If Not isFileOpen(HoursRegister & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Hours Register" & "\" & Site & "\" & HoursRegister & ".xlsm"
If Not isFileOpen(ReportTracking & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Report Tracking" & "\" & Site & "\" & ReportTracking & ".xlsm"
'Set wsHours = Workbooks(HoursRegister).Worksheets(worker)
Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
Set wsTrack = Workbooks(ReportTracking).Worksheets(Combo)
lr = wsDst.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row

'Copy the pricing cells from the quoting tool to the allocation sheet for use in calculating late cancels
Workbooks(DocYearName).Worksheets("sheet2").Range("A4:E12").Value = Data.Range("A4:E12").Value

'With wsHours
'this copies the date column in the tblCosting
'HoursRow = .Range("A" & Rows.Count).End(xlUp).Row
'tblrow.Range(, 1).Copy
'this pastes it into column A of hours register file
'.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'this copies the YP name column in the tblCosting
'tblrow.Range(, 4).Copy
'this pastes it into column B of hours register file
'.Range("B" & HoursRow).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'this copies the YP name column in the tblCosting
'tblrow.Range(, 3).Copy
'this pastes it into column A of hours register file
'.Range("C" & HoursRow).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'this copies the hours column in the tblCosting
'tblrow.Range(, 9).Copy
'this pastes it into column A of hours register file
'.Range("D" & HoursRow).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'End With
With wsTrack
'this copies the date column in the tblCosting
tblrow.Range(, 1).Copy
'this pastes it into column A of hours register file
.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'this copies the YP name column in the tblCosting
tblrow.Range(, 4).Copy
'this pastes it into column B of the report tracking file
.Range("A" & Rows.Count).End(xlUp).Offset(, 1).PasteSpecial xlPasteFormulasAndNumberFormats
'this copies the YP name column in the tblCosting
tblrow.Range(, 5).Copy
'this pastes it into column A of hours register file
.Range("A" & Rows.Count).End(xlUp).Offset(, 2).PasteSpecial xlPasteFormulasAndNumberFormats
End With
With wsDst
'This sets column width of request number column so it can be read and is not xxxxx
.Columns("C:C").ColumnWidth = 8

'This copies the first 7 columns, i.e. A:G, of the current row of the table to column A in the destination sheet.
tblrow.Range.Resize(, 7).Copy
'This pastes in the figures in the first 7 columns starting in column A
.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'This copies the first 7 columns, i.e. A:G, of the current row of the table to column A in the destination sheet.
tblrow.Range(, 10).Copy

'This pastes in the figures in the first 7 columns starting in column A
.Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats

'Overwrites the numbers pasted to column I with a formula
.Range("I" & Rows.Count).End(xlUp).Offset(1).Formula = "=IF(RC[-4]=""Activities"",0,RC[-1]*0.1)"
'Overwrites the numbers pasted to column L with a formula
.Range("J" & Rows.Count).End(xlUp).Offset(1).Formula = "=RC[-1]+RC[-2]"
'Adds currency formatting to total ex gst column
.Columns(8).NumberFormat = "$#,##0.00"
'Adds Australian date format to date column
'.Range("A:A").NumberFormat = "dd/mm/yyyy"


'sort procedure copied from vba
wsDst.Sort.SortFields.Clear
wsDst.Sort.SortFields.Add Key:=Range("A4:A" & lr), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Workbooks(DocYearName).Worksheets(Combo).Sort
'set range to sort of A3 to AO
.SetRange Range("A3:AO" & lr)
.header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
Next tblrow
Application.CutCopyMode = False
Application.ScreenUpdating = True
Exit Sub

'ErrorMsg:
' Select Case Err.Number
' Case 53
' MsgBox "Enable macros needs to be selected"
' End Select
End Sub

Thanks for your help

 

[jasonb75]

It looks good apart from one thing, in the workbook open code you need to exit without returning the variable to false, i.e.

If UnsafeToDelete = True Then Exit Sub

Although as you have a protect line commented out, if you wanted to use that line then you could simply delete the line above entirely. Unless you specifically need to exit the workbook open procedure, the line UnsafeToDelete = True before the message box is the only part that is needed there.

When the workbook open code ends either naturally or by the means of exit sub, the variable is still True when control returns to this procedure

Sub cmdCopyLineBlank_Click()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Costing_tool")

    ws.Unprotect
        Call cmdCopy
        If UnsafeToDelete = True Then
            UnsafeToDelete = False
            'ws.Protect
            Exit Sub
        Else
            Call CostingDeleteAll
              ' ws.Protect
        End If
End Sub

Using this method, you can exit as many procedures as needed (I've used it with a chain of 3 or 4 running at once). You can use If UnsafeToDelete = True Then to exit any sub or run any cleanup code needed such as protecting the sheet before exiting or clearing the clipboard. UnsafeToDelete = False should only be done at the point where you exit the final sub (in your case the Click procedure).

Hope that makes more sense.

 

[dpaton05]

Although as you have a protect line commented out, if you wanted to use that line then you could simply delete the line above entirely. Unless you specifically need to exit the workbook open procedure, the line UnsafeToDelete = True before the message box is the only part that is needed there.

Not sure which line you are referring to.

 

[dpaton05]

I have tried to implement your suggestions but now, when someone already has the file open on the network, I do get the message box, but not with the full error. The message box reads

The following user has the allocation sheets open: Then contact the user that has it open or wait until they are finished.


The error message should read

The following user has the allocation sheets open: xxxxx Please close any allocation sheets that has been opened WITHOUT SAVING THEM. Then contact the user that has it open or wait until they are finished.


All of the workbooks that the data is copied to are still opened, just opened with the new data added in read only mode so the exit part doesn't seem to be working.


This is my code

Sub Workbook_Open()

Application.WindowState = xlMaximized

Dim file1 As Integer
Dim strLine As String
file1 = FreeFile
    If Not ActiveWorkbook.ReadOnly = True Then
        'only add name to the usage log if the user has it locked
        Open ThisWorkbook.Path & "\usage.log" For Append As #file1
        Print #file1, Environ("USERNAME") & ". Please close any allocation sheets that has been opened" _
        & " WITHOUT SAVING THEM. Then contact the user that has it open or wait until they are finished."
        Close #file1
        
    Else
        'if someone else has the file open, find out who
        Open ThisWorkbook.Path & "\usage.log" For Input Access Read As #file1
            Do While Not EOF(file1)
               Line Input #file1, strLine
            Loop
        Close #file1
        'Assign true to the UnsafeToDelete variable to identify someone has it open
        UnsafeToDelete = True
        MsgBox "The following user has the allocation sheets open: " & strLine
        'If UnsafeToDelete is true, a user has the allocation sheet open, so exit sub
        If UnsafeToDelete = True Then Exit Sub
    End If


'Worksheets("home").Protect Password:="costings"

End Sub

 

[dpaton05]

I am not sure what I did. I tried it again and the message is all appearing correctly.

• The code does not stop the addtional workbooks from opening if someone already has it open
• The allocation sheets still are opened in read only mode if someone else has it open and the relevant data is put where it is meant to go
• every row in tblCosting (where the data is coming from) is deleted.
  • This means you can't add it later once the other user has stopped using it because the rows have been deleted
• You can't just press save to save the file as it is placed in a new workbook so pressing save makes multiple copies of the workbook

 

[dpaton05]

So there are still issues with it.

 

[jasonb75]

The code does not stop the addtional workbooks from opening if someone already has it open

Is this part referring to the workbook that contains the 'Workbook_Open' code? If it is, I don't think that you can check if it is open before opening, I'll have a look to see if there is a way but I think that it might just be a case of having the workbook self close after the warning message is shown.

 

[dpaton05]

But I got it to work with the line of code

End

 

[jasonb75]

That is just the nature of the beast, closing workbooks that were opened by your code it one of the things that End does whether you want it to or not (see the link in my earlier reply, somewhere around post 6).
That part can be fixed by changing the last bit of the workbook open code to

If UnsafeToDelete = True Then ThisWorkbook.Close False

Unless you add more code between your final End If and End Sub, you don't actually need to exit from that one as there is nothing happening after that point.

That just leaves the problem of the rows being deleted incorrectly, where is the line that tries to open the workbook? I had assumed that it was in the cmd_Copy procedure. If it is in the CostingDeleteAll procedure then the line If UnsafeToDelete = True Then Exit Sub will be needed in there directly after attempting to open the other workbook.
You would also need to add UnsafeToDelete = False as the very last line of the Click code (between End If and End Sub).

Hopefully that should get it working now.