Error Message When Opening Macro Created Workbook

bpdarrow · Apr 20th 2020

Hoping this is posted in the correct location.

I have a macro that creates a new workbook and pastes & formats data to 5 new sheets. It has been working flawlessly for a few weeks now. (I have attached a .txt file with the VBA script for the macro that generates the file - it is too long to enter with code tags). Until this particular file that I created today. For whatever reason, I get an error that there is a problem with some content. It only does this for this particular file, no matter how many times I delete and re-generate the file. I've tested dozens of others, and it still works.

Here is a screenshot of the message that pops up when I first open the file:

After repairing, a message confirming the repair with a link to the log file opens and this is the text within the log file:

I've been searching for a while this morning trying to figure out what it's having trouble with. There is no VBA code stored in the file that is generated, and no xml objects (at least that I can find).

The excel file that I attached brings up the error when I've tested it a few times.

How do I go about finding the issue that excel is finding?

**royUK** · Apr 20th 2020

I've looked at you code but cannot see any reason for it to cause problems. You could try switching off ScreenUpdating, etc

Code

Sub MySub()
''///
With Application
lCalc = .Calculation
''///Prevent calculation while executing code
''///Check if already set to Manual
If lCalc <> 4105 Then      ''/// calculation is not set to Manual
.Calculation = 4105    ''/// set Calculation to Manual
End If
''///Stop screen flickering
.ScreenUpdating = False
''///Speed up code if you have Worksheet or Workbook Events. Will also stop endless loops in Events.
.EnableEvents = False
''/// use error handler to ensure reset if error occurs
On Error GoTo restore


''/// your code goes here




exit_proc:
Exit Sub
restore:
.Calculation = lCalc
.ScreenUpdating = True
.EnableEvents = True
End With
Resume exit_proc:
End Sub

Display More

bpdarrow · Apr 20th 2020

Great, I'll give that a try. Anything to help clean up the code and speed the program up. Thanks Roy!

bpdarrow · Apr 21st 2020

Ok, I'm narrowing in on the section of code that is triggering the issue. I deleted all my code and started fresh with the original code you sent me last month. Then I started adding sections of code back in one sheet at a time until the error triggered again. When I added this section of code in to format the "A9" sheet, this is when I start getting the error when I try to re-open the file. Any thoughts?

Code

'//Begin A9 Formatting


Sheets("A9").Select
        Cells.Select
    Selection.ColumnWidth = 62
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit
    Rows("1:1").Select
    Application.CutCopyMode = False
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "Notes"
    Range("N1").Select
    Selection.Copy
    Range("O1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("O:O").ColumnWidth = 35
    Columns("O:O").Select
    With Selection
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B:B,I:I").Select
    Range("I1").Activate
    Selection.EntireColumn.Hidden = True
    Columns("D:D").Select
    Selection.ColumnWidth = 7
    Rows("1:1").RowHeight = 14
    Rows("1:1").EntireRow.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").Select
    Selection.ColumnWidth = 8
    Rows("1:1").EntireRow.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("J:J").Select
    Selection.ColumnWidth = 8
    Selection.ColumnWidth = 10
    Columns("J:J").EntireColumn.AutoFit
    Columns("K:K").Select
    Selection.ColumnWidth = 13
    Columns("K:K").EntireColumn.AutoFit
    Range("A1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("A9").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("A9").AutoFilter.Sort.SortFields.Add Key:=Range( _
        "K:K"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("A9").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select

Display More

**royUK** · Apr 22nd 2020

Why not have that sheet alredy formatted or a template sheet that you can use?

bpdarrow · Apr 22nd 2020

Some of the formatting can probably be done to the source workbook, I'll experiment with that. What I'm noticing after digging in further, is that the content error only comes up when there was no data available in the source workbook for that A9 sheet. The headers get copied & pasted to the new workbook, but there is no data. When there IS data there, the workbook opens with no error. Is there a better way to handle the occurrences where there is no data to paste into the new A9 sheet? Where it skips the formatting steps and moves to the next sheet?

**royUK** · Apr 22nd 2020

Where does it copy data?

bpdarrow · Apr 22nd 2020

Here is the part of the code that you helped me put together originally. I have a source workbook with 5 sheets of data, that we filter based on a specific "dealer code", copy the data from all 5 sheets, and paste into a new workbook. Commonly, there is no filtered data under 2 of the tabs for the specified dealer code (A9 and OTJ). In those instances, all that gets copied is the header row which is then pasted into the new workbook. In the attached workbook "Error Test 3", the sheet "A9" is what it looks like when there is no data to copy/paste.

I have also included an example of the source workbook.

My thought is to somehow run through each sheet after filtering by dealer code, and if cell A2 is blank, then skip the copy/paste for that sheet.

OR when formatting the new workbook sheets, first check if cell A2 on each sheet is blank and skip the section of formatting code for that sheet if it is blank.

Code

Option Explicit


Sub DAR_Automation_Prod() '//BPD version 1.0.3 4/6/20
Dim oWb As Workbook, oNewWb As Workbook
Dim oWs As Worksheet
Dim rRng As Range
Dim iX As Integer
Dim sCode As String, vNewname
Dim cell As Range
    
On Error GoTo exit_proc
Application.ScreenUpdating = False
''// The activeworkbook MUST be the desired BC workbook
Set oWb = ActiveWorkbook
''//create new workbook
Set oNewWb = Workbooks.Add
''//add 5 sheets
Application.SheetsInNewWorkbook = 5


sCode = InputBox("Enter Dealer Code", "Filter Criteria") '//Controls input box that appears to enter dealer code
If sCode = Empty Then
MsgBox "No Dealer Code Entered", vbCritical, "Process Cancelled by User"
ActiveWorkbook.Close False
Exit Sub
End If


iX = 1
For Each oWs In oWb.Worksheets
With oWs
If Not .AutoFilterMode Then .Range("A1").AutoFilter
.Range("A1").AutoFilter Field:=1, Criteria1:=sCode
Set rRng = .AutoFilter.Range
rRng.Copy
With oNewWb
.Sheets(iX).Range("A1").PasteSpecial xlAll
.Sheets(iX).Range("A1").CurrentRegion.Cells.WrapText = False
.Sheets(iX).Range("A1").CurrentRegion.Columns.AutoFit
.Sheets(iX).Name = oWs.Name
End With
iX = iX + 1
End With
Next oWs

Dim sh As Worksheet
    For Each sh In oWb.Worksheets
            If sh.AutoFilterMode Then
        sh.AutoFilter.Range.AutoFilter
    End If
Next

vNewname = Application.GetSaveAsFilename(filefilter:="Excel Files(*.xlsx), *.xlsx") '//Brings up save as dialog box
If vNewname <> False Then ActiveWorkbook.SaveAs Filename:=vNewname, FileFormat:=51
exit_proc:

Display More

**royUK** · Apr 22nd 2020

maybe something like this

Code

Set rrng = .AutoFilter.Range
If rrng.Rows.Count > 1 Then
rrng.Copy
'more code here


End If

bpdarrow · Apr 22nd 2020

Where would be the correct place in my code to add this is?

Code

Sub DAR_Automation_Prod() '//BPD version 1.0.3 4/6/20
Dim oWb As Workbook, oNewWb As Workbook
Dim oWs As Worksheet
Dim rRng As Range
Dim iX As Integer
Dim sCode As String, vNewname
Dim cell As Range
 
On Error GoTo exit_proc
Application.ScreenUpdating = False
''// The activeworkbook MUST be the desired BC workbook
Set oWb = ActiveWorkbook
''//create new workbook
Set oNewWb = Workbooks.Add
''//add 5 sheets
Application.SheetsInNewWorkbook = 5
sCode = InputBox("Enter Dealer Code", "Filter Criteria") '//Controls input box that appears to enter dealer code
If sCode = Empty Then
MsgBox "No Dealer Code Entered", vbCritical, "Process Cancelled by User"
ActiveWorkbook.Close False
Exit Sub
End If
iX = 1
For Each oWs In oWb.Worksheets
With oWs
If Not .AutoFilterMode Then .Range("A1").AutoFilter
.Range("A1").AutoFilter Field:=1, Criteria1:=sCode
Set rRng = .AutoFilter.Range
rRng.Copy
With oNewWb
.Sheets(iX).Range("A1").PasteSpecial xlAll
.Sheets(iX).Range("A1").CurrentRegion.Cells.WrapText = False
.Sheets(iX).Range("A1").CurrentRegion.Columns.AutoFit
.Sheets(iX).Name = oWs.Name
End With
iX = iX + 1
End With
Next oWs
Dim sh As Worksheet
 For Each sh In oWb.Worksheets
 If sh.AutoFilterMode Then
 sh.AutoFilter.Range.AutoFilter
 End If
Next
vNewname = Application.GetSaveAsFilename(filefilter:="Excel Files(*.xlsx), *.xlsx") '//Brings up save as dialog box
If vNewname <> False Then ActiveWorkbook.SaveAs Filename:=vNewname, FileFormat:=51
exit_proc:

Display More

**royUK** · Apr 22nd 2020

Try this

Sub DAR_Automation_Prod() '//BPD version 1.0.3 4/6/20 Dim oWb As Workbook, oNewWb As Workbook Dim oWs As Worksheet Dim rRng As Range Dim iX As Integer Dim sCode As String, vNewname Dim cell As Range On Error GoTo exit_proc Application.ScreenUpdating = False ''// The activeworkbook MUST be the desired BC workbook Set oWb = ActiveWorkbook ''//create new workbook Set oNewWb = Workbooks.Add ''//add 5 sheets Application.SheetsInNewWorkbook = 5 sCode = InputBox("Enter Dealer Code", "Filter Criteria") '//Controls input box that appears to enter dealer code If sCode = Empty Then MsgBox "No Dealer Code Entered", vbCritical, "Process Cancelled by User" ActiveWorkbook.Close False Exit Sub End If iX = 1 For Each oWs In oWb.Worksheets With oWs If Not .AutoFilterMode Then .Range("A1").AutoFilter .Range("A1").AutoFilter Field:=1, Criteria1:=sCode Set rRng = .AutoFilter.Range If rRng.Rows.Count > 1 Then rRng.Copy With oNewWb .Sheets(iX).Range("A1").PasteSpecial xlAll .Sheets(iX).Range("A1").CurrentRegion.Cells.WrapText = False .Sheets(iX).Range("A1").CurrentRegion.Columns.AutoFit .Sheets(iX).Name = oWs.Name End With iX = iX + 1 End If End With Next oWs Dim sh As Worksheet For Each sh In oWb.Worksheets If sh.AutoFilterMode Then sh.AutoFilter.Range.AutoFilter End If Next vNewname = Application.GetSaveAsFilename(filefilter:="Excel Files(*.xlsx), *.xlsx") '//Brings up save as dialog box If vNewname <> False Then ActiveWorkbook.SaveAs Filename:=vNewname, FileFormat:=51 exit_proc: End Sub

bpdarrow · Apr 22nd 2020

Success! Added that to my code, and also added if/else prior to the formatting for the A9 & OTJ sheets and now it all works again! Thanks for your help.

Code

If Range("A2") = "" Then '//Fills cell A2 with "NO DATA" and prevents formatting code from running if there is no data.
    Range("A2").Value = "NO DATA FOR DEALER CODE"
    Range("A2").Font.Bold = True
    Range("A2").Interior.ColorIndex = 27
    Range("A2").Borders.Color = vbBlack
    Range("A2").Borders.Weight = xlThick
    Cells.EntireColumn.AutoFit
    Rows("1:1").Font.Strikethrough = True
Else
'//Remaining code follows

Error Message When Opening Macro Created Workbook

Participate now!

Share

Tags