Forum Discussion
Workbook close automatically when attempting to run VBA macro
Hi Miata118 ,
If you could copy your code here, it may help troubleshooting.
If you can't, perhaps look for a line that reads something like workbook.close that is associated with your button function. This may be your issue.
Thank you for replying me to assist help on my code, kindly found the code below for your investigation, FYI, below code is not from me, it is made by someone else who is left ....I'm running a 32 bit excel and I know some of the code is for 64 bit excel, the automatic close is not always.....but once it close automatically, even I close and open the same excel again, its doesn't work, I need to recall the previous version to restore, the crashed and restored version are with the same VBA code, I did not change any code before or after, pls. help, thank you.
Sub WatchJewelry()
Dim ARR1 As Variant
Dim FN1 As Variant
ARR1 = Array("CN_W", "CN_JW", "Series_W", "Series_JW", "CN_CW", "CN_CH_FRAN", "CN_FR_FRAN", "R1", "R2", "BUD", "TH BB", "PY", "Series PY", "PY_CW")
'FN1 = "O:\Finance & Operations\Greater China Sharefolder\Templates\Daily Sales Report\China\2020\CN Daily Sales Report 2020_v1.42 - Master.xlsm"
Sheets(ARR1).Copy
Sheets(ARR1).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("CN_W").Select
Range("A1").Select
'ActiveWorkbook.BreakLink Name:=FN1, Type:=xlExcelLinks
Application.Run "BLinks"
ActiveWorkbook.SaveAs Filename:="O:\Finance & Operations\Greater China Sharefolder\Templates\Daily Sales Report\China\2020\Report\" & Range("DD2").Text & "\W&J\" & "CN Daily Sales Report_W&J (5 Brands)_" & Range("DD1").Text & ".xlsx"
End Sub
Sub Watch()
Dim ARR1 As Variant
Dim FN1 As Variant
ARR1 = Array("CN_W", "Series_W", "CN_CW", "R1", "R2", "BUD", "TH BB", "PY", "Series PY", "PY_CW")
'FN1 = "O:\Finance & Operations\Greater China Sharefolder\Templates\Daily Sales Report\China\2020\CN Daily Sales Report 2020_v1.42 - Master.xlsm"
Sheets(ARR1).Copy
Sheets(ARR1).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("R1").Select
Range("JewelleryR1").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("R2").Select
Range("JewelleryR2").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("BUD").Select
Range("JewelleryBUD").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("PY").Select
Range("JewelleryPY").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("Series PY").Select
Range("JewelleryPYSER").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("CN_W").Select
Range("A1").Select
'ActiveWorkbook.BreakLink Name:=FN1, Type:=xlExcelLinks
Application.Run "BLinks"
ActiveWorkbook.SaveAs Filename:="O:\Finance & Operations\Greater China Sharefolder\Templates\Daily Sales Report\China\2020\Report\" & Range("DD2").Text & "\Watch\" & "CN Daily Sales Report_Watch_" & Range("DD1").Text & ".xlsx"
End Sub
Sub Jewellery()
Dim ARR1 As Variant
Dim FN1 As Variant
ARR1 = Array("CN_JW", "Series_JW", "CN_CH_FRAN", "CN_FR_FRAN", "R1", "R2", "BUD", "PY", "Series PY")
'FN1 = "O:\Finance & Operations\Greater China Sharefolder\Templates\Daily Sales Report\China\2020\CN Daily Sales Report 2020_v1.42 - Master.xlsm"
Sheets(ARR1).Copy
Sheets(ARR1).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("R1").Select
Range("WatchR1").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("R2").Select
Range("WatchR2").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("BUD").Select
Range("WatchBUD").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("PY").Select
Range("WatchPY").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("Series PY").Select
Range("WatchPYSER").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("CN_JW").Select
Range("A1").Select
'ActiveWorkbook.BreakLink Name:=FN1, Type:=xlExcelLinks
Application.Run "BLinks"
ActiveWorkbook.SaveAs Filename:="O:\Finance & Operations\Greater China Sharefolder\Templates\Daily Sales Report\China\2020\Report\" & Range("DD2").Text & "\Jewellery\" & "CN Daily Sales Report_Jewellery_" & Range("DD1").Text & ".xlsx"
End Sub
Sub Chaumet()
Dim ARR1 As Variant
Dim FN1 As Variant
ARR1 = Array("CN_JW", "Series_JW", "CN_CH_FRAN", "R1", "R2", "BUD", "PY", "Series PY")
'FN1 = "O:\Finance & Operations\Greater China Sharefolder\Templates\Daily Sales Report\China\2020\CN Daily Sales Report 2020_v1.42 - Master.xlsm"
Sheets(ARR1).Copy
Sheets(ARR1).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("CN_JW").Select
Range("Fred").Select
Selection.EntireRow.Delete
Sheets("CN_JW").Name = "CN_CH"
Range("A1").Select
Sheets("Series_JW").Select
Range("FredSER").Select
Selection.EntireRow.Delete
Sheets("Series_JW").Name = "Series_CH"
Range("A1").Select
Sheets("R1").Select
Range("WatchR1").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("R1").Select
Range("FredR1").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("R2").Select
Range("WatchR2").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("R2").Select
Range("FredR2").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("BUD").Select
Range("WatchBUD").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("BUD").Select
Range("FredBUD").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("PY").Select
Range("WatchPY").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("PY").Select
Range("FredPY").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("Series PY").Select
Range("WatchPYSER").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("Series PY").Select
Range("FredPYSER").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("CN_CH").Select
Range("A1").Select
'ActiveWorkbook.BreakLink Name:=FN1, Type:=xlExcelLinks
Application.Run "BLinks"
ActiveWorkbook.SaveAs Filename:="O:\Finance & Operations\Greater China Sharefolder\Templates\Daily Sales Report\China\2020\Report\" & Range("DD2").Text & "\CH\" & "CN Daily Sales Report_CHCN_" & Range("DD1").Text & ".xlsx"
End Sub
Sub Fred()
Dim ARR1 As Variant
Dim FN1 As Variant
ARR1 = Array("CN_JW", "Series_JW", "CN_FR_FRAN", "R1", "R2", "BUD", "PY", "Series PY")
'FN1 = "O:\Finance & Operations\Greater China Sharefolder\Templates\Daily Sales Report\China\2020\CN Daily Sales Report 2020_v1.42 - Master.xlsm"
Sheets(ARR1).Copy
Sheets(ARR1).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("CN_JW").Select
Range("Chaumet").Select
Selection.EntireRow.Delete
Sheets("CN_JW").Name = "CN_FR"
Range("A1").Select
Sheets("Series_JW").Select
Range("ChaumetSER").Select
Selection.EntireRow.Delete
Sheets("Series_JW").Name = "Series_FR"
Range("A1").Select
Sheets("R1").Select
Range("WatchR1").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("R1").Select
Range("ChaumetR1").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("R2").Select
Range("WatchR2").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("R2").Select
Range("ChaumetR2").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("BUD").Select
Range("WatchBUD").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("BUD").Select
Range("ChaumetBUD").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("PY").Select
Range("WatchPY").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("PY").Select
Range("ChaumetPY").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("Series PY").Select
Range("WatchPYSER").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("Series PY").Select
Range("ChaumetPYSER").Select
Selection.EntireRow.Delete
Range("A1").Select
Sheets("CN_FR").Select
Range("A1").Select
'ActiveWorkbook.BreakLink Name:=FN1, Type:=xlExcelLinks
Application.Run "BLinks"
ActiveWorkbook.SaveAs Filename:="O:\Finance & Operations\Greater China Sharefolder\Templates\Daily Sales Report\China\2020\Report\" & Range("DD2").Text & "\FR\" & "CN Daily Sales Report_FRCN_" & Range("DD1").Text & ".xlsx"
End Sub
Sub CW()
Dim ARR1 As Variant
Dim FN1 As Variant
ARR1 = Array("CN_CW", "PY_CW")
'FN1 = "O:\Finance & Operations\Greater China Sharefolder\Templates\Daily Sales Report\China\2020\CN Daily Sales Report 2020_v1.42 - Master.xlsm"
Sheets(ARR1).Copy
Sheets(ARR1).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("CN_CW").Select
Range("A1").Select
'ActiveWorkbook.BreakLink Name:=FN1, Type:=xlExcelLinks
Application.Run "BLinks"
ActiveWorkbook.SaveAs Filename:="O:\Finance & Operations\Greater China Sharefolder\Templates\Daily Sales Report\China\2020\Report\" & Range("DD2").Text & "\CW\" & "CN Daily Sales Report_Connected Watch_" & Range("DD1").Text & ".xlsx"
End Sub
Sub BLinks()
Dim uniqueName As Name
Dim extLink As Variant, arrayXValues() As Variant, arrayValues() As Variant
Dim wb As Workbook
Dim sh As Worksheet, sh_temp As Worksheet
Call turnOffThings
Set wb = ActiveWorkbook
For Each uniqueName In wb.Names
If isNameLinkOffWorkbook(uniqueName) = True Then
uniqueName.Delete
End If
Next uniqueName
For Each sh In wb.Worksheets
Next sh
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
For Each extLink In wb.LinkSources(xlExcelLinks)
wb.BreakLink extLink, xlExcelLinks
Next extLink
End If
Call turnOnThings
End Sub
Function isNameLinkOffWorkbook(namedRangeName As Name) As Boolean
isNameLinkOffWorkbook = False
If ActiveWorkbook.Names(namedRangeName.Name).RefersTo Like "*[[]*" Or ActiveWorkbook.Names(namedRangeName.Name).RefersTo Like "*\*" Then
isNameLinkOffWorkbook = True
End If
End Function
Sub turnOffThings()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
End Sub
Sub turnOnThings()
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
Nothing major pops up when I look at the code. And you mentioned you haven't change it so let's assume the code it right for now.
I suspect you may have a mapped drive issue. Can you confirm you have access to this exact path: O:\Finance & Operations\Greater China Sharefolder\Templates\Daily Sales Report\China\2020\
This is used multiple times in the code and if it is only available on the other persons computer (the one who left), that might be your issue. Maybe that drive is mapped with a different letter on your computer?
Also, confirm you are using a version of Excel that is 2007 or newer. I really hope for newer than that for security reason but that's for another day.