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]

Is this right to fix the first bit about closing the workbooks if someone already has it open on the network? I can't test it as I am not at work today.

       VBA 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 ThisWorkbook.Close False


End If


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

End Sub

The lines to open the workbooks are in cmdCopy.

 

[jasonb75]

Yes, that is correct for the workbook open code.
You should also add the line If UnsafeToDelete = True Then Exit Sub to the cmdCopy code immediately after the line to open the other workbook.
Opening the other workbook should be done as early as possible in the cmdCopy procedure so that no unnecessary code is executed if it is read only.

 

[dpaton05]

Does this look right?

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 UnsafeToDelete = True Then Exit Sub
'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

 

[jasonb75]

Does this look right?

If the workbook referred to by DocYearName is the one being checked as read only then yes, it looks right.

 

[dpaton05]

Cool, thanks. If I want to check if the report Tracking spreadsheet is already open in the same manner, do I just include another line, the same as under the line that opens the DocYearName workbook?

 

[jasonb75]

do I just include another line, the same as under the line that opens the DocYearName workbook?

Yes, that is correct. You will also need to make the same changed to the workbook open code in the tracking sheet if you are testing it for read only as well.

 

[dpaton05]

Thanks Jason, I Will try it tomorrow when I get back to work.

 

[dpaton05]

That is partly working Jason.

I have got other assistance to update my code to use arrays and this is my code now.

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
    Dim inarr As Variant, lasttrack As Long, lastdst As Long
    Dim i As Long, kk As Long
        Application.ScreenUpdating = False
    Dim out1(1 To 1, 1 To 2) As Variant
    Dim out2(1 To 1, 1 To 10) As Variant
    
    '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
inarr = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting").DataBodyRange.Value

For i = 1 To UBound(inarr, 1)
If inarr(i, 1) = "" Or inarr(i, 5) = "" Or inarr(i, 6) = "" Then
            MsgBox "The Date, Service or Requesting Organisation has not been entered for every record in the table"
            Exit Sub
  End If
Next i
'For Each tblrow In tbl.ListRows
For i = 1 To UBound(inarr, 1)
       
        'Define combo as the month to be recorded in
'        Combo = tblrow.Range.Cells(1, 26).Value
        Combo = inarr(i, 26)
        'If column 8 for the row is blank...
'        If Not tblrow.Range(1, 8).Value = "" Then
        If Not inarr(i, 8) = "" Then
            'worker variable is defined as the value in column 8 of the row
            'worker = tblrow.Range.Cells(1, 8).Value
            worker = inarr(i, 8)
        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)
        ReportTracking = inarr(i, 39)
            Select Case Site
                Case "Wes"
                    Select Case inarr(i, 6)
'                    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
                            DocYearName = inarr(i, 37)
                        Case Else
                            'DocYearName = tblrow.Range.Cells(1, 36).Value
                            DocYearName = inarr(i, 36)
                    End Select
                Case "Riv"
                    'Select Case tblrow.Range.Cells(1, 6).Value
                    Select Case inarr(i, 6).Value                     
                        Case "Ang Wes", "Ang Wa", "Ang Al", "Ang SC", "Yiri"
                            DocYearName = inarr(i, 42)
                        Case Else
                            DocYearName = inarr(i, 36)
                    End Select

            End Select
        If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Work Allocation Sheets" & "\" & Site & "\" & DocYearName & ".xlsm"
        If UnsafeToDelete = True Then Exit Sub
'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"
        If UnsafeToDelete = True Then Exit Sub
'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 ' NOTE DATA DOESN'T SEEM TO BE DEFINED!!
      
'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
           lasttrack = .Cells(Rows.Count, "A").End(xlUp).Row + 1
              '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
            .Range(.Cells(lasttrack, 1), .Cells(lasttrack, 1)) = inarr(i, 1)
            'this copies the YP name column in the tblCosting
'            tblrow.Range(, 4).Copy
            'this pastes it into column B of the report tracking file
            out1(1, 1) = inarr(i, 4)
'            .Range(.Cells(lasttrack, 2), .Cells(lasttrack, 2)) = inarr(i, 4)
               'this copies the YP name column in the tblCosting
'            tblrow.Range(, 5).Copy
            'this pastes it into column A of hours register file
            out1(1, 2) = inarr(i, 5)
            .Range(.Cells(lasttrack, 2), .Cells(lasttrack, 3)) = out1 ' this saves 1 workhseet access
        End With
        With wsDst
          lastdst = .Cells(Rows.Count, "A").End(xlUp).Row + 1
          ' I am not sure what you are trying to do here but it can be improved
                'This sets column width of request number column so it can be read and is not xxxxx
              '  .Columns("C:C").ColumnWidth = 8 do this once at the end!!!
              
                '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
                
                For kk = 1 To 7
                out2(1, kk) = inarr(i, kk)         ' this save 7 workhseet acesses)
'                .Range(.Cells(lastdst, kk), .Cells(lastdst, kk)) = inarr(i, kk)
                Next kk
                ' this copies column 10 to column 8
                 out2(1, 8) = inarr(i, 10) ' this saves 1 access
'                .Range(.Cells(lastdst, 8), .Cells(lastdst, 8)) = inarr(i, 10)
                
                'This copies the first 7 columns, i.e. A:G, of the current row of the table to column A in the destination sheet.
                ' the comment doesn't seem t otie up wit the code here what are you doing??
                
'                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)"
               out2(1, 9) = "=IF(RC[-4]=""Activities"",0,RC[-1]*0.1)" 'this save 1 access
'                .Range(.Cells(lastdst, 9), .Cells(lastdst, 9)).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]"
                out2(1, 10) = "=RC[-1]+RC[-2]"
               ' .Range(.Cells(lastdst, 10), .Cells(lastdst, 10)).Formula = "=RC[-1]+RC[-2]"
               .Range(.Cells(lastdst, 1), .Cells(lastdst, 10)) = out2 ' this writes all 10 columns in one go
                'Adds currency formatting to total ex gst column
 '               .Columns(8).NumberFormat = "$#,##0.00" do this at the end
                'Adds Australian date format to date column
                '.Range("A:A").NumberFormat = "dd/mm/yyyy"
  
   
                'sort procedure copied from vba
                'DO NOT DO THIS SORT ON EVERY ITERATION IT WILL BE MAJOR CAUSE OF YOUR TIME PROBLEM
        End With
'    Next tblrow
    Next i
          With wsDst
            lr = .Cells(Rows.Count, "A").End(xlUp).Row ' line added to make sure you sort the whole sheet if rows have been added
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=Range("A4:A" & lr), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Columns("C:C").ColumnWidth = 8
        End With
        
                With Workbooks(DocYearName).Worksheets(Combo)
                  lr = .Cells(Rows.Count, "A").End(xlUp).Row ' line added to make sure you sort the whole worksheet
                    'set range to sort of A3 to AO
                    .Sort.SortFields.Add Key:=Range("B4:B" & lr) ' line added since you hadn't put a sort column in I chose B!!!
                    .Sort.header = xlYes
                    .Sort.MatchCase = False
                    .Sort.Orientation = xlTopToBottom
                    .Sort.SortMethod = xlPinYin
                    .Sort.Apply
                End With
    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

The only problem with it now is if the relevant allocation sheet is open on the network, the procedure ends with no additional workbooks being opened but if the report tracking worksheet has been opened by someone else, as the line of code comes after the line to open the allocation sheets, the allocation sheet is still opened. I wasn't sure of the syntax to ensure no sheets are opened if one of the files is already open.

 

[jasonb75]

Sorry, just want to make sure that I'm following correctly, been a long day and my malfunction is braining ?

Are you saying that if the code detects that one workbook is read only then any other workbooks that the code opened earlier should also be closed? If that is the case then you would need to change

If UnsafeToDelete = True Then Exit Sub

to

If UnsafeToDelete = True Then
    Workbooks("Allocation Sheet.xlsm").Close False
    Exit Sub
End If

You will need to change the workbook name definition to match the one in your code.

 

[dpaton05]

Do I change just the first instance of

If UnsafeToDelete = True Then Exit Sub

so my code looks like

               'Select Case tblrow.Range.Cells(1, 6).Value
                    Select Case inarr(i, 6).Value                     
                        Case "Ang Wes", "Ang Wa", "Ang Al", "Ang SC", "Yiri"
                            DocYearName = inarr(i, 42)
                        Case Else
                            DocYearName = inarr(i, 36)
                    End Select

            End Select
        If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Work Allocation Sheets" & "\" & Site & "\" & DocYearName & ".xlsm"
        

       If UnsafeToDelete = True Then
           Workbooks("Allocation Sheet.xlsm").Close False  
           Exit Sub  
        End If
   '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"
        
       If UnsafeToDelete = True Then
           Workbooks("Report Tracking.xlsm").Close False  
           Exit Sub  
        End If
'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

Do I only include it only once after the first line that opens the allocation sheet or do I include it after each line?