Save workbook & close with confirmation message

[ipbr21054]

I am using the code below.
Basically i transfer values from one workbook to another.
The code added is just to save & then close workbook but i keep getting asked to cintinue etc.

Please advise what i should change so i dont have to select YES each time.
Screenshot attached

  Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

   If Not Intersect(Range("C6", Cells(Rows.Count, "C").End(xlUp)), Target) Is Nothing Then
    Cancel = True
    Dim WB As Workbook, DestWB As Workbook
    Dim WS As Worksheet, DestWS As Worksheet
    Dim rng As Range, rngDest As Range
    Dim ColArr As Variant, SCol As Variant, DCol As Variant
   
    On Error Resume Next
    Set DestWB = Application.Workbooks("KEY CODES.xlsm")

    If DestWB Is Nothing Then
        Workbooks.Open fileName:="C:\Users\Ian\Desktop\REMOTES ETC\DR\EXCEL WORKSHEETS\KEY CODES.xlsm"
        Set DestWB = Application.Workbooks("KEY CODES.xlsm")
    End If
    On Error GoTo 0

    Set WB = ThisWorkbook
    On Error Resume Next
    Set WS = WB.Worksheets("DATABASE")
    On Error GoTo 0
    If WS Is Nothing Then
        MsgBox "Worksheet 'DATABASE' is missing"
        Exit Sub
    End If
   
    Set DestWS = DestWB.Worksheets("KEYCODES")
    ColArr = Array("D:A", "C:B", "J:C", "K:D")
   
    Application.ScreenUpdating = False
    For Each SCol In ColArr
        DCol = Split(SCol, ":")(1)
        SCol = Split(SCol, ":")(0)
        With WS
            Set rng = .Cells(Target.Row, SCol)
        End With
        With DestWS
            If IsEmpty(.Range(DCol & 1)) Then
                Set rngDest = .Range(DCol & 1)
            Else
                Set rngDest = .Range(DCol & .Rows.Count).End(xlUp).Offset(1)
            End If
        End With
       
        rng.Copy
        rngDest.PasteSpecial Paste:=xlPasteAll
        rngDest.Borders.Weight = xlThin
        rngDest.Font.Size = 14
        rngDest.Font.Bold = True
        rngDest.HorizontalAlignment = xlCenter
        rngDest.Cells.Interior.ColorIndex = 6
        rngDest.Cells.RowHeight = 25
    Next SCol
    Application.ScreenUpdating = True
   End If
   ActiveWorkbook.Close _
   SaveChanges:=True, _
   fileName:="C:\Users\Ian\Desktop\REMOTES ETC\DR\EXCEL WORKSHEETS\KEY CODES.xlsm"
End Sub

 

[Micron]

I would save the workbook first, then close it. Try

With ActiveWorkbook
   .Save
   .Saved = True
   .Close
End With

but I caution against using activeworkbook if you have 2 wb's open at the same time. Better to be specific, or if closing the wb where the code is, I think I'd use ThisWorkbook.
Another way would be to turn off application alerts, save then close, turn alerts back on. That would not be my first choice.

 

[ipbr21054]

I would save the workbook first, then close it. Try

With ActiveWorkbook
   .Save
   .Saved = True
   .Close
End With

but I caution against using activeworkbook if you have 2 wb's open at the same time. Better to be specific, or if closing the wb where the code is, I think I'd use ThisWorkbook.
Another way would be to turn off application alerts, save then close, turn alerts back on. That would not be my first choice.

Please advise what i should try as i read your reply which advises what to try but followed by not my first try etc etc

Im easily going to do this wrong so await for your input please.

 

[Micron]

Replace what you have in red with what I gave you - IF the active workbook is this one:
"C:\Users\Ian\Desktop\REMOTES ETC\DR\EXCEL WORKSHEETS\KEY CODES.xlsm"

 

[ipbr21054]

Now applied thanks

 

[Micron]

Since you marked my post as a solution (thanks), I guess it worked. In that case, glad I could help.

 

[ipbr21054]

It did many thanks for your input