Home » excel » VBA Excel: “Automation Error. Exception occurred.” when using UserForm

VBA Excel: “Automation Error. Exception occurred.” when using UserForm

Posted by: admin May 14, 2020 Leave a comment

Questions:

A few days I made this post, but with less code and I’ve tried something new (unsuccessfully).

My code copies data from one sheet to another. It’s a total of 12 workbooks that get data from 6 workbooks each.

The first step is that I show the user a UserForm, where they can select a year and a quarter. The code itself works when:

  1. I leave out the Userform and enter the date (= the variables qVar,
    yVar and fullDate) directly inside the code.

  2. I leave in the Userform, but reduce the number of workbooks from 12
    to maybe 7 or so.

If I use the UserForm with all 12 workbooks, I get the

“Automation Error. Exception Occurred.”

enter image description here

Important: Debugging doesn’t work because when I use F8 to go through the code, it works without a problem.

Problematic userform

Option Explicit

'=================UserForm causing problems==============
Private Sub cmdAbbrechen_Click()
    Unload Me
End Sub

Private Sub cmdOk_Click()
    Dim QuartalStr As String
    Dim oControl As Control

    If cboJahr.Value = "" Then
        MsgBox "Bitte Jahr auswählen"
        Exit Sub
    End If

    For Each oControl In frmQuartalsauswahl.fraQuartale.Controls
        If oControl.Value = True Then
            qVar = oControl.Caption
        End If
    Next oControl

    yVar = CStr(cboJahr.Value)

    Select Case qVar
        Case "Q1"
            fullDate = yVar & ".03.31"
        Case "Q2"
            fullDate = yVar & ".06.30"
        Case "Q3"
            fullDate = yVar & ".09.30"
        Case "Q4"
            fullDate = yVar & ".12.31"
    End Select

    Unload Me
    Call MitUserForm.Quartalsbericht
End Sub


Private Sub UserForm_Initialize()
    Dim yearsArray() As Integer
    Dim startyear As Integer
    Dim i As Integer

    startyear = 2017
    i = 0

    Do While startyear <= Year(Date)
        ReDim Preserve yearsArray(i)
        yearsArray(i) = startyear
        startyear = startyear + 1
        i = i + 1
    Loop
    cboJahr.List = yearsArray
End Sub

Error-handling userform

Option Explicit

Private Sub cmdCancel_Click()
    Unload Me
    End
End Sub

Private Sub cmdContinue_Click()
    Unload Me
End Sub

Private Sub cmdContinueNoSave_Click()
    saveVar = False
    Unload Me
End Sub

Private Sub UserForm_Initialize() 'frmFehler
    Me.txtFehlermeldung.Text = Join(ErrorArray, ", ")
End Sub

Actual code

Option Explicit
Public fullDate As String
Public yVar As Long
Public qVar As String
Public saveVar As Boolean
Sub ShowUserformQuartal()
frmQuartalsauswahl.Show
End Sub
Sub Quartalsbericht()
Dim VWNumberReal As String
Dim ErrorMessage As String
Dim Item As Variant
Dim FilePath As String
Dim ErrorCount As Long
'code works if I set date like this:
'yVar = 2018
'qVar = "Q4"
'fullDate = "2018.12.31"
Dim VWArray As Variant
Dim FondsArray As Variant
Dim rng As Range, rngHeader As Range
Dim wbVWQB As Workbook, wb As Workbook
Dim wsVWQB As Worksheet
Dim lCol As Long, lColNew As Long
Dim FondsArt As Variant, VWNumber As Variant
Dim wbClose As Workbook
FilePath = "H:\Report\"
VWArray = Array("21", "21FV", "25", "35", "45", "46", "49", "51", "52", "53", "54", "101")
saveVar = True
'======================Do files exist?=====================
For Each VWNumber In VWArray
If Dir$(FilePath & VWNumber & "Quartalsbericht.xlsx") = "" Then
ErrorMessage = "Quartalsbericht" & VWNumber
ReDim Preserve ErrorArray(ErrorCount)
ErrorArray(ErrorCount) = ErrorMessage
ErrorCount = ErrorCount + 1
End If
If VWNumber = "21FV" Then
FondsArray = Array("AnlFonds", "AnlMischung", "NW670", "FVNW671", "NW673")
VWNumber = "21"
VWNumberReal = "21FV"
ElseIf VWNumber = "49" Then
FondsArray = Array("AnlFonds", "AnlMischung", "AnlStreuung", "NW670", "NW671", "NW673")
ElseIf qVar = "Q4" Then
FondsArray = Array("AnlFonds", "AnlMischung", "AnlStreuung", "NW670", "NW671", "NW673")
Else
FondsArray = Array("AnlFonds", "AnlMischung", "AnlStreuung", "NW670", "NW673")
End If
For Each FondsArt In FondsArray
If Dir$(FilePath & yVar & "\" & fullDate & "\" & VWNumber & FondsArt & qVar & yVar & ".xlsx") = "" Then
ErrorMessage = VWNumber & FondsArt & qVar & yVar
ReDim Preserve ErrorArray(ErrorCount)
ErrorArray(ErrorCount) = ErrorMessage
ErrorCount = ErrorCount + 1
End If
Next FondsArt
Next VWNumber
If ErrorCount > 0 Then
frmFehler.Show
End If
Application.ScreenUpdating = False
For Each VWNumber In VWArray
If Dir$(FilePath & VWNumber & "Quartalsbericht.xlsx") = "" Then
GoTo MissingVWFile
End If
Set wbVWQB = Application.Workbooks.Open(FilePath & VWNumber & "Quartalsbericht.xlsx")
wbVWQB.SaveAs FilePath & "Backups\" & VWNumber & "Quartalsbericht_old_" & Format(Now(), "dd-mm-yyyy hh-mm-ss") & ".xlsx"  'backup
Application.DisplayAlerts = False ' = automatisches Überschreiben der alten Datei
wbVWQB.SaveAs FilePath & VWNumber & "Quartalsbericht.xlsx" 'ursprünglicher Name, so dass workbooks außerhalb des Loops gespeichert werden können
Application.DisplayAlerts = True
If VWNumber = "21FV" Then
Debug.Print "Fall 1: " & VWNumber
FondsArray = Array("AnlFonds", "AnlMischung", "NW670", "FVNW671", "NW673")
ElseIf VWNumber = "49" Then
Debug.Print "Fall 2: " & VWNumber
FondsArray = Array("AnlFonds", "AnlMischung", "AnlStreuung", "NW670", "NW671", "NW673")
ElseIf qVar = "Q4" Then
Debug.Print "Fall 3: " & VWNumber
FondsArray = Array("AnlFonds", "AnlMischung", "AnlStreuung", "NW670", "NW671", "NW673")
Else
Debug.Print "Fall 4: " & VWNumber
FondsArray = Array("AnlFonds", "AnlMischung", "AnlStreuung", "NW670", "NW673")
End If
If VWNumber = "21FV" Then
VWNumberReal = "21FV"
VWNumber = "21"
End If
Debug.Print "If VW Number = 21FV: Real: " & VWNumberReal & " VWNumber: " & VWNumber
For Each FondsArt In FondsArray
If Dir$(FilePath & yVar & "\" & fullDate & "\" & VWNumber & FondsArt & qVar & yVar & ".xlsx") = "" Then
GoTo MissingFondsFile
End If
Set wb = Application.Workbooks.Open(FilePath & yVar & "\" & fullDate & "\" & VWNumber & FondsArt & qVar & yVar & ".xlsx")
Set wsVWQB = wbVWQB.Sheets(FondsArt)
lCol = wsVWQB.Cells(2, Columns.Count).End(xlToLeft).Column + 1
If VWNumberReal <> "21FV" Then
Select Case wb.Name
Case VWNumber & "AnlFonds" & qVar & yVar & ".xlsx"
If VWNumber = "21" Then
wb.ActiveSheet.Range("E1:E1").Copy wbVWQB.Sheets(FondsArt).Cells(2, lCol)
wb.ActiveSheet.Range("E31:E118").Copy: wbVWQB.Sheets(FondsArt).Cells(3, lCol).PasteSpecial xlPasteAllUsingSourceTheme
Else
wb.ActiveSheet.Range("D1").Copy wbVWQB.Sheets(FondsArt).Cells(2, lCol)
wb.ActiveSheet.Range("D31:D118").Copy: wbVWQB.Sheets(FondsArt).Cells(3, lCol).PasteSpecial xlPasteAllUsingSourceTheme
End If
Case VWNumber & "AnlMischung" & qVar & yVar & ".xlsx"
wb.ActiveSheet.Range("E1:F200").Copy: wbVWQB.Sheets(FondsArt).Cells(2, lCol).PasteSpecial xlPasteAllUsingSourceTheme
Case VWNumber & "AnlStreuung" & qVar & yVar & ".xlsx"
lCol = wsVWQB.Cells(3, Columns.Count).End(xlToLeft).Column + 1
wb.ActiveSheet.Range("A9:G200").Copy: wbVWQB.Sheets(FondsArt).Cells(3, lCol).PasteSpecial xlPasteAllUsingSourceTheme
Case VWNumber & "NW670" & qVar & yVar & ".xlsx"
wb.ActiveSheet.Range("C1:C200").Copy: wbVWQB.Sheets(FondsArt).Cells(2, lCol).PasteSpecial xlPasteAllUsingSourceTheme
Case VWNumber & "NW671" & qVar & yVar & ".xlsx"
wb.ActiveSheet.Range("C1:F1").Copy wbVWQB.Sheets(FondsArt).Cells(2, lCol)
wb.ActiveSheet.Range("C46:F200").Copy: wbVWQB.Sheets(FondsArt).Cells(3, lCol).PasteSpecial xlPasteAllUsingSourceTheme
Case VWNumber & "FVNW671" & qVar & yVar & ".xlsx"
wb.ActiveSheet.Range("C1:F1").Copy wbVWQB.Sheets(FondsArt).Cells(2, lCol)
wb.ActiveSheet.Range("C46:F200").Copy: wbVWQB.Sheets(FondsArt).Cells(3, lCol).PasteSpecial xlPasteAllUsingSourceTheme
Case VWNumber & "NW673" & qVar & yVar & ".xlsx"
wb.ActiveSheet.Range("C1:C100").Copy: wbVWQB.Sheets(FondsArt).Cells(2, lCol).PasteSpecial xlPasteAllUsingSourceTheme
wb.ActiveSheet.Range("F1:F100").Copy: wbVWQB.Sheets(FondsArt).Cells(2, lCol + 1).PasteSpecial xlPasteAllUsingSourceTheme
End Select
Else 'VWNumberReal = "21FV"
Select Case wb.Name
Case VWNumber & "AnlFonds" & qVar & yVar & ".xlsx"
wb.ActiveSheet.Range("D1").Copy wbVWQB.Sheets(FondsArt).Cells(2, lCol)
wb.ActiveSheet.Range("D31:D118").Copy: wbVWQB.Sheets(FondsArt).Cells(3, lCol).PasteSpecial xlPasteAllUsingSourceTheme
Case VWNumber & "AnlMischung" & qVar & yVar & ".xlsx"
wb.ActiveSheet.Range("C1:D200").Copy: wbVWQB.Sheets(FondsArt).Cells(2, lCol).PasteSpecial xlPasteAllUsingSourceTheme
Case VWNumber & "NW670" & qVar & yVar & ".xlsx"
wb.ActiveSheet.Range("D1:D200").Copy: wbVWQB.Sheets(FondsArt).Cells(2, lCol).PasteSpecial xlPasteAllUsingSourceTheme
Case VWNumber & "FVNW671" & qVar & yVar & ".xlsx"
wb.ActiveSheet.Range("C1:F1").Copy wbVWQB.Sheets(FondsArt).Cells(2, lCol)
wb.ActiveSheet.Range("C46:F200").Copy: wbVWQB.Sheets(FondsArt).Cells(3, lCol).PasteSpecial xlPasteAllUsingSourceTheme
Case VWNumber & "NW673" & qVar & yVar & ".xlsx"
wb.ActiveSheet.Range("D1:D100").Copy: wbVWQB.Sheets(FondsArt).Cells(2, lCol).PasteSpecial xlPasteAllUsingSourceTheme
wb.ActiveSheet.Range("F1:F100").Copy: wbVWQB.Sheets(FondsArt).Cells(2, lCol + 1).PasteSpecial xlPasteAllUsingSourceTheme
End Select
End If
If FondsArt = "AnlStreuung" Then
lColNew = wsVWQB.Cells(3, Columns.Count).End(xlToLeft).Column
wsVWQB.Range(wsVWQB.Cells(2, lCol), wsVWQB.Cells(2, lColNew)).Interior.Color = RGB(128, 128, 128) 'grey (empty) header
Else
lColNew = wsVWQB.Cells(2, Columns.Count).End(xlToLeft).Column
End If
'year and quarter as headline
With wsVWQB
.Range(.Cells(1, lCol), .Cells(1, lColNew)).Merge
.Cells(1, lCol).Value = qVar & " " & yVar
.Cells(1, lCol).HorizontalAlignment = xlCenter
.Cells(1, lCol).Font.Bold = True
.Cells(1, lCol).Font.Color = vbWhite
.Cells(1, lCol).Interior.Color = RGB(128, 128, 128)
.Range(.Cells(2, lCol), .Cells(2, lColNew)).Font.Bold = True
.Range(.Cells(2, lCol), .Cells(2, lColNew)).Font.Color = vbWhite
End With
Call LeftBorder(lCol, wbVWQB, wsVWQB)
wb.Close SaveChanges:=False
MissingFondsFile:
VWNumberReal = ""
Next FondsArt
wbVWQB.Close SaveChanges:=saveVar
Application.CutCopyMode = False
MissingVWFile:
Next VWNumber
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub LeftBorder(lCol As Long, wbVWQB As Workbook, wsVWQB As Worksheet)
Dim lRow As Long
Debug.Print wsVWQB.Name
Debug.Print lCol
With wsVWQB
Select Case .Name
Case "AnlMischung"
.Range(.Cells(1, lCol), .Cells(63, lCol)).Borders(xlEdgeLeft).LineStyle = xlContinuous
.Range(.Cells(1, lCol), .Cells(63, lCol)).Borders(xlEdgeLeft).Weight = xlThick
Case "AnlStreuung"
lRow = .Cells(Rows.Count, lCol + 6).End(xlUp).Row
.Range(.Cells(1, lCol), .Cells(lRow, lCol)).Borders(xlEdgeLeft).LineStyle = xlContinuous
.Range(.Cells(1, lCol), .Cells(lRow, lCol)).Borders(xlEdgeLeft).Weight = xlThick
Case "NW671"
.Range(.Cells(1, lCol), .Cells(73, lCol)).Borders(xlEdgeLeft).LineStyle = xlContinuous
.Range(.Cells(1, lCol), .Cells(73, lCol)).Borders(xlEdgeLeft).Weight = xlThick
Case "FVNW671"
.Range(.Cells(1, lCol), .Cells(73, lCol)).Borders(xlEdgeLeft).LineStyle = xlContinuous
.Range(.Cells(1, lCol), .Cells(73, lCol)).Borders(xlEdgeLeft).Weight = xlThick
Case "NW673"
.Range(.Cells(1, lCol), .Cells(50, lCol)).Borders(xlEdgeLeft).LineStyle = xlContinuous
.Range(.Cells(1, lCol), .Cells(50, lCol)).Borders(xlEdgeLeft).Weight = xlThick
End Select
End With
End Sub

Initially I left the 12 workbooks open and I thought this might cause the issue, but with the new version of my code I can say it doesn’t.

How to&Answers:

I think I found the solution for this. For months opening a UserForm without first having the form open in VBA editor would tank the entire program.

Another thread pointed out that Excel changed to loading forms in parallel, so when one piece finishes before the other it causes the whole thing to crash. Almost like your friend texting you “here” when they’re still 3 blocks away, and if you head outside before they get to your house you die. Anyways.

If you call your UserForm with a button, add this to the Button_click() sub.

ThisWorkbook.VBProject.VBComponents("UserForm").Activate 

It tells Excel to load the form as soon as you click the button, instead of loading everything that goes into the form first. This does essentially the same thing as opening a VBA window.

Hope this helps!