Save workbook & close with confirmation message

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,699
Office Version
  1. 2007
Platform
  1. Windows
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

Rich (BB code):
  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
 

Attachments

  • EaseUS_2023_07_15_18_51_25.jpg
    EaseUS_2023_07_15_18_51_25.jpg
    25.1 KB · Views: 18

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
I would save the workbook first, then close it. Try
VBA Code:
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.
 
Upvote 0
Solution
I would save the workbook first, then close it. Try
VBA Code:
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.
 
Upvote 0
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"
 
Upvote 0
Since you marked my post as a solution (thanks), I guess it worked. In that case, glad I could help.
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,849
Members
452,361
Latest member
d3ad3y3

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