Forum Discussion

Miata118's avatar
Miata118
Copper Contributor
Aug 30, 2020

Workbook close automatically when attempting to run VBA macro

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

3 Replies

  • Bennadeau's avatar
    Bennadeau
    Iron Contributor

    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.

    • Miata118's avatar
      Miata118
      Copper Contributor

      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

       

      • Bennadeau's avatar
        Bennadeau
        Iron Contributor

        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.