Workbook close automatically when attempting to run VBA macro

Copper Contributor

I have try to run the macro but the workbook close automatically, pls. help

3 Replies

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.

@Bennadeau 

 

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

 

@Miata118 

 

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.