Excel VBA shows Userform randomly - vba

Question

I've just gotten into programming VBA, and have very little other programming experience.
I'll first describe the intention of the macro:
So, there are an x number of excel files with data in them. All these files follow the same basic design:
Column A contains the 'name' of the data I want. There are ten rows with different names.
Column M contains the data corresponding to the name of column A (an average value of the columns in between)
This average data has to be transferred to a 'master' excel file.
I've made a userform to select the files that need to be imported, which appears to work fine (at least selecting the files)
I call the userform within my module using
usrform.show
As said, I'm able to run the userform. Just when I click apply within the userform, it stops the code and opens the excel vba editor and displays the graphical userform.
No idea what's causing this. Do Any of you have input?
Public strListe_selected() As String
Public booDatenAbbrechen As Boolean
Sub Ergebnisse_einlesen()
Dim datei As String
Dim liste As String
Dim test As Variant
Dim name As String
Dim nPh As Integer
Dim Suche As String
Dim Excel_Daten() As Variant
Dim rngFound As Range
Dim rngFound1 As Range
Dim Komponente() As String
Dim startreihe As Integer
Dim SMK As String
Dim dateinr As Integer
Dim strdatumformatiert As String
Dim strerstellungsdatum() As String
Dim intantwort As Integer
Dim strdatum As String
Dim Phase As String
'*************************************Zeit messen um Einlesezeit zu optimieren
Dim t
t = Now
'*************************************Zeile controlieren, somit kein daten in die falsche zeile kommt
startreihe = ActiveCell.Row
If startreihe < 10 Then
MsgBox "Bitte markieren sie die Zeile in der die neuen Testdaten eingetragen werden sollen und führen sie das Makro erneut aus"
Exit Sub
ElseIf Cells(startreihe, 3) <> "" Then
antwort = MsgBox("Die markierte Zeile enthält bereits Daten, wollen sie diese überschreiben?", vbOKCancel)
If antwort = vbCancel Then Exit Sub
End If
'************************************Sammeln von Informationen über diese Arbeitsmappe
liste = ThisWorkbook.ActiveSheet.name
letztespalte = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
name = ThisWorkbook.name
'************************************Dialogfenster öffnen
xls_suchen.Show
If booDatenAbbrechen = True Then Exit Sub
For dateinr = 0 To UBound(strListe_selected) 'Schleife über die gewählten xls-Dateien
Application.ScreenUpdating = False 'Bildschirmanzeige unterdrücken
Workbooks.Open Filename:=Element & strListe_selected(dateinr) 'öffnen der xls-Datei
'**********************************************************************************************************************
'neudimensionieren des ARRAYs
c = 4
emdat = anzkomp * (c + 1)
ReDim Excel_Daten(24 + emdat, 3)
'Spaltenüberschrift des Arrays "Excel_Daten" festlegen
Excel_Daten(0, 0) = "Name"
Excel_Daten(0, 1) = "Reihe"
Excel_Daten(0, 2) = "Spalte"
Excel_Daten(0, 3) = "Wert"
'**********************************************************************************************************************
'******************************** Daten aus der Excel-Datei lesen *******************************************************
i = 2
For k = 1 To anzkomp
Suche = Komponente(k)
Excel_Daten(i, 0) = Komponente(k)
Set rngFound = Cells.Find(What:="Bemerkung:")
test = Cells(rngFound.Row, rngFound.Column).Value
If test = "Bemerkung:" Then
anzkomp = 11
nPh = 1
ReDim Komponente(anzkomp)
Testergebnis = "Phase"
Komponente(1) = "F_eth"
Komponente(2) = "F_Lakor_m"
Komponente(3) = "F_lradap1c[0]"
Komponente(4) = "F_lradap1c[1]"
Komponente(5) = "F_lradap1c[2]"
Komponente(6) = "F_lradap1c[3]"
Komponente(7) = "F_lradap1c[4]"
Komponente(8) = "F_lradap1c[5]"
Komponente(9) = "F_lradap1c[6]"
Komponente(10) = "F_lradap1c[7]"
Komponente(11) = "Km_st_1"
Else
MsgBox "Der test ist nicht bekannt. Ist der Datei ein EDR Messdatei?"
End If
Set rngFound1 = Cells.Find(What:="Phase")
If rngFound1 Is Nothing Then
MsgBox Testergebnis & "nicht gefunden"
Else
Set rngFound = Cells.Find(What:=Suche, After:=Cells(rngFound1.Row, rngFound1.Column))
If rngFound Is Nothing Then
If Suche = "F_eth" Then n = 2
If Suche = "F_Lakor_m" Then n = 5
If Suche = "F_lradap1c[0]" Then n = 8
If Suche = "F_lradap1c[1]" Then n = 11
If Suche = "F_lradap1c[2]" Then n = 14
If Suche = "F_lradap1c[3]" Then n = 17
If Suche = "F_lradap1c[4]" Then n = 20
If Suche = "F_lradap1c[5]" Then n = 23
If Suche = "F_lradap1c[6]" Then n = 26
If Suche = "F_lradap1c[7]" Then n = 29
If Suche = "Km_st_1" Then n = 32
For i = n To n + 4
If i <> n Then Excel_Daten(i, 0) = Suche & "_PH" & i - n
Excel_Daten(1, 3) = ""
Next i
Else
Excel_Daten(i, 1) = rngFound.Row
Excel_Daten(i, 2) = rngFound.Column
Excel_Daten(i, 3) = Cells(rngFound.Row, rngFound.Column + 12).Value
i = i + 1
For j = 1 To c
If j > nPh Then
If Suche = "F_eth" Then n = 2
If Suche = "F_Lakor_m" Then n = 5
If Suche = "F_lradap1c[0]" Then n = 8
If Suche = "F_lradap1c[1]" Then n = 11
If Suche = "F_lradap1c[2]" Then n = 14
If Suche = "F_lradap1c[3]" Then n = 17
If Suche = "F_lradap1c[4]" Then n = 20
If Suche = "F_lradap1c[5]" Then n = 23
If Suche = "F_lradap1c[6]" Then n = 26
If Suche = "F_lradap1c[7]" Then n = 29
If Suche = "Km_st_1" Then n = 32
Excel_Daten(n + j, 0) = Suche & "_PH" & j
Excel_Daten(n + j, 3) = ""
i = i + 1
End If
Next j
End If
End If
Next k
'Einlesen der Ergebnisse abgeschlossen --> schließen der VTS-Datei
ActiveWorkbook.Close
'**********************************************************************************************
'**********************************************************************************************
'Daten in gewünschtes Tabellenblatt übertragen
For b = 1 To 12
ThisWorkbook.Worksheets(liste).Cells(startreihe, b + 1) = Excel_Daten(b, 3)
Next b
b = 12
For a = 13 To 10 + emdat
ThisWorkbook.Worksheets(liste).Cells(startreihe, b + 3) = Excel_Daten(a, 3)
If Excel_Daten(a, 0) = "GRAMS_KM_CO2" Or Excel_Daten(a, 0) = "GRAMS_MI_CO2" _
Or Excel_Daten(a, 0) = "FUEL_CONS_MPG" Or Excel_Daten(a, 0) = "FUEL_CONS_KPL" _
Or Excel_Daten(a, 0) = "FUEL_CONS_LP100K" Then
b = b
ElseIf Excel_Daten(a + 1, 0) = Excel_Daten(a, 0) & "_PH1" Then
b = b + 2
End If
For i = 1 To c
a = a + 1
b = b + 1
ThisWorkbook.Worksheets(liste).Cells(startreihe, b + 3) = Excel_Daten(a, 3)
Next i
b = b + 1
'If a < emdat + 10 Then
' If test = "US06V1_FE" And VTS_Daten(a + 1, 0) = "FUEL_CONS_MPG" Then B = B + 5
'End If
Next a
Application.ScreenUpdating = True 'Bildschirmanzeige zulassen
Next dateinr
End Sub
Userform:
Private Sub button_cancel_Click()
ReDim strListe_selected(0) 'Liste wird gelöscht
booDatenAbbrechen = True
Unload Me
End Sub
Private Sub button_all_Click()
With Me.ListBox1
For i = 0 To .ListCount - 1
ListBox1.Selected(i) = True
Next
End With
End Sub
Private Sub button_none_Click()
With Me.ListBox1
For i = 0 To .ListCount - 1
ListBox1.Selected(i) = False
Next
End With
End Sub
Private Sub button_apply_Click()
booDatenAbbrechen = False
With Me.ListBox1
liste = .List
j = 0
For i = 0 To .ListCount - 1
If .Selected(i) Then
ReDim Preserve strListe_selected(j)
strListe_selected(j) = liste(i, 0)
j = j + 1
End If
Next
End With
Unload Me
End Sub
Private Sub button_add_file_Click()
add_files
End Sub
Private Sub button_add_folder_Click()
add_folder
End Sub
Sub add_folder()
Dim objAppShell As Object
Dim varBrowseDir As Variant
Dim strPfad As String
Dim varUnterordner As Variant
Dim objFileSystem As Object
Dim varOrdner As Variant
Dim Element
Dim strFilelist() As String
Dim i As Integer
Dim strFile As String
Dim FD As FileDialog
Set FD = Application.FileDialog(msoFileDialogFolderPicker)
With FD
.AllowMultiSelect = True
If Application.FileDialog(msoFileDialogFolderPicker).Show = 0 Then
Else
strPfad = .SelectedItems(1)
End If
End With
If strPfad = "" Then Exit Sub
'Ordner nach *.xls-Dateien durchsuchen
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set varOrdner = objFileSystem.GetFolder(strPfad)
Set varUnterordner = varOrdner.SubFolders
i = 0
ReDim Preserve strFilelist(i)
'Hauptordner durchsuchen
strFile = Dir(strPfad & "\" & "*.xls") 'Ersten Eintrag wählen
Do While strFile <> ""
strFilelist(i) = strPfad & "\" & strFile
ListBox1.AddItem (strFilelist(i))
i = i + 1
ReDim Preserve strFilelist(i)
strFile = Dir 'strFile = Dir 'Get nächsten Eintrag.
Loop
'Unterordner durchsuchen
For Each Element In varUnterordner
strFile = Dir(strPfad & "\" & Element.name & "\" & "*.xls")
Do While strFile <> ""
ReDim Preserve strFilelist(i)
strFilelist(i) = strPfad & "\" & Element.name & "\" & strFile
ListBox1.AddItem (strFilelist(i))
i = i + 1
strFile = Dir 'strFile = Dir 'Get nächsten Eintrag.
Loop
Next
End Sub
Sub add_files()
Dim FD As FileDialog
Dim Element
Dim i As Integer
Set FD = Application.FileDialog(msoFileDialogOpen)
With FD
.AllowMultiSelect = True
'.InitialFileName = ActiveWorkbook.Path & "\*.xls"""
.Filters.Clear
.Filters.Add "Excel dateien", "*.xls"
End With
i = 1
If FD.Show = -1 Then
For Each Element In FD.SelectedItems
' datei = Dir(Element, "*.xls")
ListBox1.AddItem (FD.SelectedItems(i))
Next
End If
End Sub