Blank duplicate still open when open and close workbook with VBA

[mnordeen]

Hello,
I am really going to do my best to explain this problem I am having, Also I have searched this site and others found nothing but maybe I am searching with the wrong terms.

I have a main workbook that uses several other workbooks to save/archive information, several of the operations require it to open other workbooks copy info into them then close them. The main workbook stays open and is used to modify and view the information. When any of the codes do this I have a blank sheet in the background every time it opens and closes any of these other storage workbooks.

I cannot use

Application.quit

as that will close Excel completely.

I have one of the codes below, there are some functions it uses but I don't believe they are relevant so I did not include them. (the status bar) I am aware the macro could be cleaned up and shortened but my first step is to make sure they work as is before I clean them up. But I will be happy to get feed back on that as well.

Sub MainSendEsttoDB()
'Send estimates to DB
 On Error Resume Next
 
 Dim strPath As String
 Dim strFile As String
 Dim strRef1 As String
 Dim wkbDest As Workbook
 Dim wkbSource As Workbook
 Dim LastRow As Long
 Dim SR As Long
 Dim SC As Long
 Dim a As Long

'(Step Begin) Display your Progress Bar
Application.Visible = False
ufProgress.LabelProgress.Width = 0
ufProgress.Show vbModeless

'Pre Step Set up to run fast
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 Application.DisplayStatusBar = False
 Application.EnableEvents = False

FractionComplete (0.2) '(Step 1)
Application.Wait (Now + TimeValue("0:00:01"))
Application.ScreenUpdating = False

'Step 2 Open the DB in use and mark it not available
  strPath = Sheets("DataCabB").Cells(7, 10).Value
  strFile = Sheets("DataCabB").Cells(7, 12).Value ' should be the DataCabAA Line
  strRef1 = strPath & strFile
  Set wkbDest = ThisWorkbook
  Set wkbSource = Workbooks.Open(strRef1)

FractionComplete (0.4) '(Step 1)
Application.Wait (Now + TimeValue("0:00:01"))
Application.ScreenUpdating = False

'Step 3 Copy the files to the destination
   For SR = 2 To 1001
    LastRow = wkbSource.Sheets("DataCabA").Range("E10050").End(xlUp).Row + 1
     If wkbDest.Sheets("DataCabA").Cells(SR, 5).Value <= wkbDest.Sheets("Main").Cells(13, 45).Value And wkbDest.Sheets("DataCabA").Cells(SR, 5).Value >= wkbDest.Sheets("Main").Cells(13, 44).Value Then
      For SC = 3 To 1842
       wkbSource.Sheets("DataCabA").Cells(LastRow, SC).Value = wkbDest.Sheets("DataCabA").Cells(SR, SC).Value
      Next SC
      Else
    End If
   Next SR

FractionComplete (0.6) '(Step 1)
Application.Wait (Now + TimeValue("0:00:01"))
Application.ScreenUpdating = False

'Step 4 Delete Duplicates
   For a = wkbSource.Worksheets("DataCabA").Cells(Rows.Count, 5).End(xlUp).Row To 1 Step -1
   If WorksheetFunction.CountIf(Range("E1:E" & a), Cells(a, 5)) > 1 Then
    For SC = 3 To 1842
      wkbSource.Worksheets("DataCabA").Cells(a, SC).ClearContents
    Next SC
   End If
 Next
 
FractionComplete (0.8) '(Step 1)
Application.Wait (Now + TimeValue("0:00:01"))
Application.ScreenUpdating = False
 
'Step 5  Sort the Destination
    wkbSource.Worksheets("DataCabA").Sort.SortFields.clear
    wkbSource.Worksheets("DataCabA").Sort.SortFields.Add2 Key:=Range( _
        "G2:G1001"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    wkbSource.Worksheets("DataCabA").Sort.SortFields.Add2 Key:=Range( _
        "E2:E1001"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    wkbSource.Worksheets("DataCabA").Sort.SortFields.Add2 Key:=Range( _
        "F2:F1001"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    wkbSource.Worksheets("DataCabA").Sort.SortFields.Add2 Key:=Range( _
        "D2:D1001"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With wkbSource.Worksheets("DataCabA").Sort
        .SetRange Range("C1:BRV10001")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
FractionComplete (0.9) '(Step 1)
Application.Wait (Now + TimeValue("0:00:01"))
Application.ScreenUpdating = False

'Step 7 Close the DB {Save}
 wkbSource.Close SaveChanges:=True
 
 Sheets("Main").Select
 
 FractionComplete (1) '(Step Final)
 Unload ufProgress
 
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 Application.DisplayStatusBar = True
 Application.EnableEvents = True
 Application.Visible = True

End Sub

Thank you in advance for your help,

 

[Yongle]

Try adding these lines at bottom of your code

    With Application
        .DisplayAlerts = False
        .Windows(1).Close
        .DisplayAlerts = True
    End With

To see a warning message with opportunity to cancel

   Application.Windows(1).Close

 

[Yongle]

I looked at your post again - I do not think that my solution will work for you

 

[mnordeen]

No it Sure did not, Thank you for trying.