Late binding => Wie umsetzen?

Sub cmd_ford_click()
Dim offnen
Dim msg
Dim feld_ford()
Dim zeile
Dim i
Dim hilf
Dim hilf2
Dim hilfW
Dim j
Dim PGes
Dim ii
Dim summe_hw
Dim summe_fw
Dim jj
Dim z
Dim actWB
Dim FordWB
Dim newFileName
Dim path_anhang
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo errorhandling
'*******************************    FORDERUNGEN BEARBEITEN   ***********************************************************
'Workbook mit Forderungen öffnen
offnen = Application.GetOpenFilename("Excel files (*.xls), *.xls, All files (*.*), *.*", 4, "Open the file receivables")
If offnen = False Then
'wenn öffnen abgebrochen, alles abbrechen
msg = MsgBox("Open was terminated, import the receivables is terminated", vbOKOnly + vbCritical, "Process is terminated")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
Else
actWB = ActiveWorkbook.Name
Application.StatusBar = "***  Please have patience. The import of the receivables occurs at the moment.  ***"
'öffnen
Workbooks.Open Filename:=offnen
'sortieren nach PartGes, Referenz, Belegdatum
ActiveWorkbook.ActiveSheet.Columns("A:K").Sort Key1:=ActiveWorkbook.ActiveSheet.Range("B1"), Order1:=xlAscending, Key2:=ActiveWorkbook.ActiveSheet.Range("E1") _
, Order2:=xlAscending, Key3:=ActiveWorkbook.ActiveSheet.Range("G1"), Order3:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'sortieren nach PartGes, Fremdwährung, Referenz  (für Sortierung Fremdwährung, nur 3 Schlüssel möglich)
ActiveWorkbook.ActiveSheet.Columns("A:K").Sort Key1:=ActiveWorkbook.ActiveSheet.Range("B1"), Order1:=xlAscending, Key2:=ActiveWorkbook.ActiveSheet.Range("K1") _
, Order2:=xlAscending, Key3:=ActiveWorkbook.ActiveSheet.Range("E1"), Order3:=xlAscending, Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Schleife über alle Einträge
FordWB = ActiveWorkbook.Name
path_anhang = ActiveWorkbook.Path
z = 2
Do While ActiveWorkbook.ActiveSheet.Range("B" & z) <> ""
PGes = ActiveWorkbook.ActiveSheet.Range("B" & z)
ii = z
i = 0
' Wieviel Einträge pro PartGes
'Prüfung Part-Ges nummerisch für clng
If IsNumeric(ActiveWorkbook.ActiveSheet.Range("B" & ii)) = False Then
msg = MsgBox("The partner comp. of the file doesn't correspond to a numeral. " & vbCr & "Please Check. The process is terminated.", vbOKOnly + vbCritical, "Wrong data format: partner company")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
End If
Do While CLng(ActiveWorkbook.ActiveSheet.Range("B" & ii)) = CLng(PGes)
i = i + 1
ii = ii + 1
If IsNumeric(ActiveWorkbook.ActiveSheet.Range("B" & ii)) = False Then
msg = MsgBox("The partner comp. of the file doesn't correspond to a numeral. " & vbCr & "Please Check. The process is terminated.", vbOKOnly + vbCritical, "Wrong data format: partner company")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
End If
Loop
'Datenfeld auf genaue Größe definieren
ReDim feld_ford(i, 8)
'für 2. Schleife, muss ab Anfang PGes wieder laufen
ii = z
'Schleifenzähler eins hochzählen
z = z + i
zeile = 0
Do While CLng(ActiveWorkbook.ActiveSheet.Range("B" & ii)) = CLng(PGes)
'Werte in internes Datenfeld füllen zur Übertragung
feld_ford(zeile, 0) = ActiveWorkbook.ActiveSheet.Range("B" & ii).Value 'feld (x, 0): PartGes
feld_ford(zeile, 1) = ActiveWorkbook.ActiveSheet.Range("D" & ii).Value 'feld (x, 1): Belegnr
feld_ford(zeile, 2) = ActiveWorkbook.ActiveSheet.Range("E" & ii).Value 'feld (x, 2): Referenz
feld_ford(zeile, 3) = ActiveWorkbook.ActiveSheet.Range("F" & ii).Value 'feld (x, 3): Text
feld_ford(zeile, 4) = ActiveWorkbook.ActiveSheet.Range("G" & ii).Value 'feld (x, 4): Belegdatum
feld_ford(zeile, 5) = ActiveWorkbook.ActiveSheet.Range("I" & ii).Value 'feld (x, 5): Betrag HW
feld_ford(zeile, 6) = ActiveWorkbook.ActiveSheet.Range("J" & ii).Value 'feld (x, 6): Betrag BW
'Prüfung ob Betrage nummerisch, sonst Infomeldung
If IsNumeric(feld_ford(zeile, 5)) = False Or IsNumeric(feld_ford(zeile, 6)) = False Then
msg = MsgBox("The Value Amount LC or Amount FC in the file " & vbCr & offnen & "," & vbCr & " int. Account No. " & feld_ford(zeile, 1) & " doesn't correspond to a numeral. Please check and change." & vbCr & "The process is terminated.", vbCritical + vbOKOnly, "Wrong data format: Value")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
End If
feld_ford(zeile, 7) = ActiveWorkbook.ActiveSheet.Range("K" & ii).Value 'feld (x, 7): BuKrs Währung
feld_ford(zeile, 8) = ActiveWorkbook.ActiveSheet.Range("H" & ii).Value 'feld (x, 8): HausWährung
hilf = ActiveWorkbook.ActiveSheet.Range("A" & ii).Value
hilfW = ActiveWorkbook.ActiveSheet.Range("H" & ii).Value
zeile = zeile + 1
ii = ii + 1
Loop
Workbooks(actWB).Activate
'Prüfung richtiger BuKrs
hilf2 = Sheets("Master Data").Range("E6").Value
'Prüfung BuKrs numerisch, Sonst läuft clng auf Fehler
If IsNumeric(hilf) = False Or IsNumeric(hilf2) = False Then
msg = MsgBox("The comp. of the file or the Master Data Sheet doesn't correspond to a numeral. " & vbCr & "Please Check. The process is terminated.", vbOKOnly + vbCritical, "Wrong data format: company")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
End If
If CLng(hilf) <> CLng(hilf2) Then
msg = MsgBox("The company of the file doesn't match to the selected company " & vbCr & "of the Master Data sheet. The process is terminated.", vbOKOnly + vbCritical, "No matching data: company")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
End If
'Prüfung richtige Währung
If LCase(hilfW) <> LCase(Sheets("Master Data").Range("B6").Value) Then
msg = MsgBox("The currency of the file doesn't match to the selected currency " & vbCr & "of the Master Data sheet. The process is terminated.", vbOKOnly + vbCritical, "No matching data: currency")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
End If
'Standardwerte übertragen in Forderungen
Sheets("Receivables").Range("H2").Value = Sheets("Master Data").Range("B4").Value         'Firma
Sheets("Receivables").Range("H3").Value = Sheets("Master Data").Range("E6").Value         'eig.Ges-Nr.
Sheets("Receivables").Range("H4").Value = Sheets("Master Data").Range("B6").Value         'Währung
Sheets("Receivables").Range("H5").Value = Sheets("Master Data").Range("B8").Value         'Sachbearb.
Sheets("Receivables").Range("H6").Value = Sheets("Master Data").Range("B10").Value        'Email
Sheets("Receivables").Range("H7").Value = Sheets("Master Data").Range("B12").Value        'Tel
Sheets("Receivables").Range("H8").Value = Sheets("Master Data").Range("E12").Value        'Fax
'Standardwerte übertragen in S - 1
Sheets("S - I").Range("G2").Value = Sheets("Master Data").Range("B4").Value         'Firma
Sheets("S - I").Range("G3").Value = Sheets("Master Data").Range("E6").Value         'eig.Ges-Nr.
Sheets("S - I").Range("G4").Value = Sheets("Master Data").Range("B6").Value         'Währung
Sheets("S - I").Range("G5").Value = Sheets("Master Data").Range("B8").Value         'Sachbearb.
Sheets("S - I").Range("G6").Value = Sheets("Master Data").Range("B10").Value        'Email
Sheets("S - I").Range("G7").Value = Sheets("Master Data").Range("B12").Value        'Tel
Sheets("S - I").Range("G8").Value = Sheets("Master Data").Range("E12").Value        'Fax
'Speichern für Vorlage
ActiveWorkbook.Save
'Buchungsdatum übertragen
Sheets("Receivables").Range("H9").Value = Sheets("Master Data").Range("B14").Value  'BuchDate
Sheets("S - I").Range("G9").Value = Sheets("Master Data").Range("B14").Value        'BuchDate
Sheets("Master Data").Range("E14").Value = PGes                                     'Abstimmgesellschaft
'Werte übertragen
Sheets("Receivables").Activate
j = 0
summe_hw = 0
summe_fw = 0
jj = 34
Do While feld_ford(j, 0) <> ""
Sheets("Receivables").Range("B" & j + 19).Value = feld_ford(j, 1)     'Belegnr int
Sheets("Receivables").Range("C" & j + 19).Value = feld_ford(j, 2)     'Belegnr ext
Sheets("Receivables").Range("E" & j + 19).Value = feld_ford(j, 4)     'BuchDate
Sheets("Receivables").Range("G" & j + 19).Value = feld_ford(j, 5)     'Wert HW
Sheets("Receivables").Range("H" & j + 19).Value = feld_ford(j, 6)     'Wert BW
Sheets("Receivables").Range("I" & j + 19).Value = feld_ford(j, 7)     'BuWäh
Sheets("Receivables").Range("J" & j + 19).Value = feld_ford(j, 3)     'Text
'Summe Hauswährung ermitteln
summe_hw = summe_hw + feld_ford(j, 5)
'Summe pro Fremdwährung ermitteln
If j <> i Then
If LCase(feld_ford(j, 7)) = LCase(feld_ford(j + 1, 7)) Then
summe_fw = summe_fw + feld_ford(j, 6)
Else
'Summe Fremdwährung in Sheet S1 übertragen
summe_fw = summe_fw + feld_ford(j, 6)
Sheets("S - I").Range("I" & jj).Value = summe_fw
Sheets("S - I").Range("G" & jj).Value = feld_ford(j, 7)
jj = jj + 2
summe_fw = 0
End If
Else
summe_fw = summe_fw + feld_ford(j, 6)
Sheets("S - I").Range("I" & jj).Value = summe_fw
Sheets("S - I").Range("G" & jj).Value = feld_ford(j, 7)
jj = jj + 2
summe_fw = 0
End If
j = j + 1
Loop
'Summe Hauswährung in Sheet S1 übertragen
Sheets("S - I").Range("D34").Value = summe_hw
'abstimmenden BuKrs mit Text übertragen
zeile = 2
Sheets("Receivables").Range("E8").Value = PGes
Sheets("S - I").Range("D8").Value = PGes
Do While Sheets("comp. data").Range("A" & zeile) <> ""
If CLng(Sheets("comp. data").Range("A" & zeile)) = CLng(PGes) Then
Sheets("Receivables").Range("B8").Value = Sheets("comp. data").Range("B" & zeile)
Sheets("Receivables").Range("E8").Value = Sheets("comp. data").Range("A" & zeile)
Sheets("S - I").Range("B8").Value = Sheets("comp. data").Range("B" & zeile)
Sheets("S - I").Range("D8").Value = Sheets("comp. data").Range("A" & zeile)
Exit Do
End If
zeile = zeile + 1
Loop
'Button Receivables unsichtbar machen in neuer Datei, andere Buttons sichtbar machen
Sheets("Master Data").cmd_ford.Visible = False
Sheets("Master Data").cmd_verb.Visible = True
Sheets("Master Data").cmd_abgl.Visible = True
Sheets("Master Data").Activate
'Datei als Kopie speichern
newFileName = "Reconciliation of balances S-I_Comp-" & hilf & " to Comp-" & PGes & ".xls"
'check_datei_vorhanden newFileName
ActiveWorkbook.SaveCopyAs newFileName
'Daten aus Vorlage Datei wieder löschen
Sheets("Receivables").Rows("19:" & j + 21).ClearContents
Sheets("Receivables").Range("B8:E8").ClearContents
Sheets("Receivables").Range("H9").ClearContents
Sheets("S - I").Range("D34").ClearContents
Sheets("S - I").Range("G9").ClearContents
Sheets("S - I").Range("G34:I" & jj).ClearContents
Sheets("S - I").Range("B8:D8").ClearContents
'Datei Forderungen wieder aktivieren
Workbooks(FordWB).Activate
Loop
'Datei Forderungen wieder schliessen
ActiveWorkbook.Close savechanges:=False
'Button wieder herstellen für vorlage
Sheets("Master Data").cmd_ford.Visible = True
Sheets("Master Data").cmd_verb.Visible = False
Sheets("Master Data").cmd_abgl.Visible = False
Sheets("Master Data").Range("E14").ClearContents
ActiveWorkbook.Save
End If
msg = MsgBox("Import of receivables was successfully!", vbInformation + vbOKOnly, "Operation successful")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
errorhandling:
msg = MsgBox("ERROR! Please contact an ITA-2 or CCA-51 employee and note the following information." & vbCr & vbCr & Err.Number & " - " & Err.Description, vbCritical + vbOKOnly, "Error")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
'Button wieder herstellen für vorlage
Sheets("Master Data").cmd_ford.Visible = True
Sheets("Master Data").cmd_verb.Visible = False
Sheets("Master Data").cmd_abgl.Visible = False
Sheets("Master Data").Range("E14").ClearContents
'Daten aus Vorlage Datei wieder löschen
Sheets("Receivables").Rows("19:9999").ClearContents
Sheets("Receivables").Range("B8:E8").ClearContents
Sheets("Receivables").Range("H9").ClearContents
Sheets("S - I").Range("D34").ClearContents
Sheets("S - I").Range("G9").ClearContents
Sheets("S - I").Range("G34:I48").ClearContents
Sheets("S - I").Range("B8:D8").ClearContents
End
End Sub

Sub cmd_verb_click()
Dim offnen
Dim i
Dim zeile
Dim feld_verb()
Dim hilf
Dim PartGes
Dim j
Dim msg
Dim hilf2
On Error GoTo errorhandling
'******************************    VERBINDLICHKEITEN BEARBEITEN    **********************************************************
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Tabellenblatt leeren falls mehrere Durchläufe
Sheets("payables").Range("A19:J9999").ClearContents
PartGes = Sheets("Receivables").Range("E8")
'Verbindlichkeiten einlesen in neue Datei
offnen = Application.GetOpenFilename("Excel Files (*.xls), *.xls, All Files (*.*), *.*", 4, "Open the file payables from comp-" & PartGes)
If offnen = False Then
'wenn öffnen abgebrochen, alles abbrechen
msg = MsgBox("Open was terminated, inport the payables is terminated", vbOKOnly + vbCritical, "Process is terminated")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
Else
Application.StatusBar = "***  Please have patience. The import of the payables occurs at the moment.  ***"
'öffnen
Workbooks.Open Filename:=offnen
'sortieren nach Belegnr, Belegdatum
ActiveWorkbook.ActiveSheet.Columns("A:K").Sort Key1:=ActiveWorkbook.ActiveSheet.Range("E1"), Order1:=xlAscending, Key2:=ActiveWorkbook.ActiveSheet.Range("G1") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Anzahl Einträge zählen
i = 0
If IsNumeric(ActiveWorkbook.ActiveSheet.Range("A" & i + 2)) = False Or IsNumeric(PartGes) = False Then
msg = MsgBox("The partner comp. of the file doesn't correspond to a numeral. " & vbCr & "Please Check. The process is terminated.", vbOKOnly + vbCritical, "Wrong data format: partner company")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
End If
Do While ActiveWorkbook.ActiveSheet.Range("A" & i + 2) <> "" And CLng(ActiveWorkbook.ActiveSheet.Range("A" & i + 2)) = CLng(PartGes)
i = i + 1
If IsNumeric(ActiveWorkbook.ActiveSheet.Range("A" & i + 2)) = False Or IsNumeric(PartGes) = False Then
msg = MsgBox("The partner comp. of the file doesn't correspond to a numeral. " & vbCr & "Please Check. The process is terminated.", vbOKOnly + vbCritical, "Wrong data format: partner company")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
End If
Loop
'Datenfeld auf genaue Größe definieren
ReDim feld_verb(i, 8)
'Werte in internes Datenfeld füllen zur Übertragung
zeile = 2
Do While ActiveWorkbook.ActiveSheet.Range("A" & zeile).Value <> ""
'Prüfung richtiger Abstimm Bukrs
If CLng(ActiveWorkbook.ActiveSheet.Range("A" & zeile)) = CLng(PartGes) Then
feld_verb(zeile - 2, 0) = ActiveWorkbook.ActiveSheet.Range("A" & zeile).Value  'feld (x, 0): PartGes
feld_verb(zeile - 2, 1) = ActiveWorkbook.ActiveSheet.Range("D" & zeile).Value  'feld (x, 1): Belegnr
feld_verb(zeile - 2, 2) = ActiveWorkbook.ActiveSheet.Range("E" & zeile).Value  'feld (x, 2): Referenz
feld_verb(zeile - 2, 3) = ActiveWorkbook.ActiveSheet.Range("F" & zeile).Value  'feld (x, 3): Text
feld_verb(zeile - 2, 4) = ActiveWorkbook.ActiveSheet.Range("G" & zeile).Value  'feld (x, 4): Belegdatum
feld_verb(zeile - 2, 5) = ActiveWorkbook.ActiveSheet.Range("H" & zeile).Value  'feld (x, 5): Betrag HW
feld_verb(zeile - 2, 6) = ActiveWorkbook.ActiveSheet.Range("J" & zeile).Value  'feld (x, 6): Betrag BW
'Prüfung ob Betrage nummerisch, sonst Infomeldung
If IsNumeric(feld_verb(zeile - 2, 5)) = False Or IsNumeric(feld_verb(zeile - 2, 6)) = False Then
msg = MsgBox("The Value Amount LC or Amount FC in the file " & vbCr & offnen & "," & vbCr & " int. Account No. " & feld_verb(zeile - 2, 1) & " doesn't correspond to a numeral. Please check and change." & vbCr & "The process is terminated.", vbCritical + vbOKOnly, "Wrong data format: Value")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
End If
feld_verb(zeile - 2, 7) = ActiveWorkbook.ActiveSheet.Range("K" & zeile).Value  'feld (x, 7): BuKrs Währung
feld_verb(zeile - 2, 8) = ActiveWorkbook.ActiveSheet.Range("I" & zeile).Value  'feld (x, 8): HausWährung
hilf = ActiveWorkbook.ActiveSheet.Range("B" & zeile).Value
zeile = zeile + 1
Else
msg = MsgBox("Payables for the comp  " & ActiveWorkbook.ActiveSheet.Range("A" & zeile) & " were found in the file." & vbCr & "This one doesn't match with the selected recon. comp " & PartGes & vbCr & "The process is terminated.", vbOKOnly + vbCritical, "Wrong data: partner company")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
End If
Loop
ActiveWorkbook.Close savechanges:=False
'Prüfung überhaupt Daten übertragen?
If zeile = 2 Then
msg = MsgBox("For the comp. " & PartGes & " no payables were found in the file." & vbCr & "The process is terminated.", vbOKOnly + vbCritical, "Missing data: Payables")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
End If
'Prüfung richtiger BuKrs
hilf2 = Sheets("Master Data").Range("E6").Value
'BuKrs nummerisch? sonst läuft clng auf Fehler
If IsNumeric(hilf) = False Or IsNumeric(hilf2) = False Then
msg = MsgBox("The comp. of the file or the Master Data Sheet doesn't match with a numeral. " & vbCr & "The process is terminated.", vbOKOnly + vbCritical, "Wrong data format: company")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
End If
If CLng(hilf) <> CLng(hilf2) Then
msg = MsgBox("The comp. of the file doesn't match with the selected comp. " & vbCr & "on the Master data sheet. The process is terminated.", vbOKOnly + vbCritical, "No matching data: company")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
End If
'Standardwerte übertragen
Sheets("payables").Range("H2").Value = Sheets("Master Data").Range("B4").Value         'Firma
Sheets("payables").Range("H3").Value = Sheets("Master Data").Range("E6").Value         'eig.Ges-Nr.
Sheets("payables").Range("H4").Value = Sheets("Master Data").Range("B6").Value         'Währung
Sheets("payables").Range("H5").Value = Sheets("Master Data").Range("B8").Value         'Sachbearb.
Sheets("payables").Range("H6").Value = Sheets("Master Data").Range("B10").Value        'Email
Sheets("payables").Range("H7").Value = Sheets("Master Data").Range("B12").Value        'Tel
Sheets("payables").Range("H8").Value = Sheets("Master Data").Range("E12").Value        'Fax
Sheets("payables").Range("H9").Value = Sheets("Master Data").Range("B14").Value        'BuchDate
'Werte übertragen
Sheets("payables").Activate
j = 0
Do While feld_verb(j, 0) <> ""
Sheets("payables").Range("B" & j + 19).Value = feld_verb(j, 1)       'Belegnr int
Sheets("payables").Range("C" & j + 19).Value = feld_verb(j, 2)       'Belegnr ext
Sheets("payables").Range("E" & j + 19).Value = feld_verb(j, 4)       'BuchDate
Sheets("payables").Range("F" & j + 19).Value = feld_verb(j, 8)       'HW
Sheets("payables").Range("G" & j + 19).Value = feld_verb(j, 5)       'Wert HW
Sheets("payables").Range("H" & j + 19).Value = feld_verb(j, 6)       'Wert BW
Sheets("payables").Range("I" & j + 19).Value = feld_verb(j, 7)       'BuWäh
Sheets("payables").Range("J" & j + 19).Value = feld_verb(j, 3)       'Text
j = j + 1
Loop
'Stammdaten übertragen
Sheets("payables").Range("E8").Value = PartGes                                 'PartGes
Sheets("payables").Range("B8").Value = Sheets("Receivables").Range("B8").Value 'Text PartGes
End If
ActiveWorkbook.Save
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
errorhandling:
msg = MsgBox("ERROR! Please contact a ITA-2 or CCA-51 employee and note the following information." & vbCr & vbCr & Err.Number & " - " & Err.Description, vbCritical + vbOKOnly, "Error")
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
End Sub

Sub cmd_abgl_click()
Dim i_f
Dim i_v
Dim r
Dim z_v
Dim z_f
Dim i
Dim msg
On Error GoTo errorhandling
'************************************************  Abgleich  ********************************************************************
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.StatusBar = "***  Please have patience. The reconciliation occurs at the moment.  ***"
'Tabellenblatt leeren falls mehrere Durchläufe
Sheets("Reconciliation").Range("B19:F9999").ClearContents
'Buttons für Filter einblenden
Sheets("Reconciliation").cmd_display_all.Visible = True
Sheets("Reconciliation").cmd_display_diff.Visible = True
Sheets("Reconciliation").cmd_display_rec_miss.Visible = True
Sheets("Reconciliation").cmd_display_pay_miss.Visible = True
Sheets("Reconciliation").cmd_send.Visible = True
'Standardwerte übertragen
Sheets("Reconciliation").Range("G2").Value = Sheets("Master Data").Range("B4").Value         'Firma
Sheets("Reconciliation").Range("G3").Value = Sheets("Master Data").Range("E6").Value         'eig.Ges-Nr.
Sheets("Reconciliation").Range("G4").Value = Sheets("Master Data").Range("B6").Value         'Währung
Sheets("Reconciliation").Range("G5").Value = Sheets("Master Data").Range("B8").Value         'Sachbearb.
Sheets("Reconciliation").Range("G6").Value = Sheets("Master Data").Range("B10").Value        'Email
Sheets("Reconciliation").Range("G7").Value = Sheets("Master Data").Range("B12").Value        'Tel
Sheets("Reconciliation").Range("G8").Value = Sheets("Master Data").Range("E12").Value        'Fax
Sheets("Reconciliation").Range("G9").Value = Sheets("Master Data").Range("B14").Value        'BuchDate
Sheets("Reconciliation").Range("D8").Value = Sheets("Receivables").Range("E8").Value         'PartGes
Sheets("Reconciliation").Range("B8").Value = Sheets("Receivables").Range("B8").Value         'Text PartGes
'Anzahl der Einträge Receivables des BuKrs zählen
i_f = 0
Do While Sheets("Receivables").Range("B" & i_f + 19) <> ""
i_f = i_f + 1
Loop
'Anzahl der Einträge Verbindlichkeiten des BuKrs zählen
i_v = 0
Do While Sheets("payables").Range("B" & i_v + 19) <> ""
i_v = i_v + 1
Loop
'Abgleich der Werte starten
r = 19
For z_v = 0 To i_v - 1
For z_f = 0 To i_f - 1
If Sheets("Receivables").Range("C" & z_f + 19) = Sheets("payables").Range("C" & z_v + 19) Then  'externe Belegnummer
Sheets("Receivables").Range("D" & z_f + 19) = "X"
Sheets("payables").Range("D" & z_v + 19) = "X"
If Sheets("Receivables").Range("E" & z_f + 19) <> Sheets("payables").Range("E" & z_v + 19) Then 'BuchDate
If CDbl(Sheets("Receivables").Range("H" & z_f + 19)) <> CDbl(Sheets("payables").Range("H" & z_v + 19)) * -1 Then   'Betrag BW
If LCase(Sheets("Receivables").Range("I" & z_f + 19)) <> LCase(Sheets("payables").Range("I" & z_v + 19)) Then  'Währung
'Beleg gleich, Datum ungleich, Betrag ungleich, Währung ungleich
msg = MsgBox("Currency not equal, ext. account no. " & Sheets("payables").Range("C" & z_v + 19), vbOKOnly + vbInformation, "Different Currency")
Sheets("Reconciliation").Range("B" & r) = Sheets("Receivables").Range("C" & z_f + 19)
Sheets("Reconciliation").Range("C" & r) = Sheets("Receivables").Range("E" & z_f + 19)
Sheets("Reconciliation").Range("D" & r) = Sheets("Receivables").Range("H" & z_f + 19)
Sheets("Reconciliation").Range("E" & r) = Sheets("Receivables").Range("I" & z_f + 19)
Sheets("Reconciliation").Range("F" & r) = Sheets("Receivables").Range("J" & z_f + 19)
Sheets("Reconciliation").Range("B" & r + 1) = Sheets("payables").Range("C" & z_v + 19)
Sheets("Reconciliation").Range("C" & r + 1) = Sheets("payables").Range("E" & z_v + 19)
Sheets("Reconciliation").Range("D" & r + 1) = Sheets("payables").Range("H" & z_v + 19)
Sheets("Reconciliation").Range("E" & r + 1) = Sheets("payables").Range("I" & z_v + 19)
Sheets("Reconciliation").Range("F" & r + 1) = Sheets("payables").Range("J" & z_v + 19)
Sheets("Reconciliation").Range("C" & r + 2) = "not equal"
Sheets("Reconciliation").Range("D" & r + 2) = CDbl(Sheets("Receivables").Range("H" & z_f + 19)) + CDbl(Sheets("payables").Range("H" & z_v + 19))
Sheets("Reconciliation").Range("E" & r + 2) = "not equal"
r = r + 4
Else
'Beleg gleich, Datum ungleich, Betrag ungleich, Währung gleich
Sheets("Reconciliation").Range("B" & r) = Sheets("Receivables").Range("C" & z_f + 19)
Sheets("Reconciliation").Range("C" & r) = Sheets("Receivables").Range("E" & z_f + 19)
Sheets("Reconciliation").Range("D" & r) = Sheets("Receivables").Range("H" & z_f + 19)
Sheets("Reconciliation").Range("E" & r) = Sheets("Receivables").Range("I" & z_f + 19)
Sheets("Reconciliation").Range("F" & r) = Sheets("Receivables").Range("J" & z_f + 19)
Sheets("Reconciliation").Range("B" & r + 1) = Sheets("payables").Range("C" & z_v + 19)
Sheets("Reconciliation").Range("C" & r + 1) = Sheets("payables").Range("E" & z_v + 19)
Sheets("Reconciliation").Range("D" & r + 1) = Sheets("payables").Range("H" & z_v + 19)
Sheets("Reconciliation").Range("E" & r + 1) = Sheets("payables").Range("I" & z_v + 19)
Sheets("Reconciliation").Range("F" & r + 1) = Sheets("payables").Range("J" & z_v + 19)
Sheets("Reconciliation").Range("C" & r + 2) = "not equal"
Sheets("Reconciliation").Range("D" & r + 2) = CDbl(Sheets("Receivables").Range("H" & z_f + 19)) + CDbl(Sheets("payables").Range("H" & z_v + 19))
Sheets("Reconciliation").Range("E" & r + 2) = Sheets("Receivables").Range("I" & z_f + 19)
r = r + 4
End If
Else
'Beleg gleich, Datum ungleich, Betrag gleich
Sheets("Reconciliation").Range("B" & r) = Sheets("Receivables").Range("C" & z_f + 19)
Sheets("Reconciliation").Range("C" & r) = Sheets("Receivables").Range("E" & z_f + 19)
Sheets("Reconciliation").Range("D" & r) = Sheets("Receivables").Range("H" & z_f + 19)
Sheets("Reconciliation").Range("E" & r) = Sheets("Receivables").Range("I" & z_f + 19)
Sheets("Reconciliation").Range("F" & r) = Sheets("Receivables").Range("J" & z_f + 19)
Sheets("Reconciliation").Range("B" & r + 1) = Sheets("payables").Range("C" & z_v + 19)
Sheets("Reconciliation").Range("C" & r + 1) = Sheets("payables").Range("E" & z_v + 19)
Sheets("Reconciliation").Range("D" & r + 1) = Sheets("payables").Range("H" & z_v + 19)
Sheets("Reconciliation").Range("E" & r + 1) = Sheets("payables").Range("I" & z_v + 19)
Sheets("Reconciliation").Range("F" & r + 1) = Sheets("payables").Range("J" & z_v + 19)
Sheets("Reconciliation").Range("C" & r + 2) = "not equal"
Sheets("Reconciliation").Range("D" & r + 2) = CDbl(Sheets("Receivables").Range("H" & z_f + 19)) + CDbl(Sheets("payables").Range("H" & z_v + 19))
Sheets("Reconciliation").Range("E" & r + 2) = Sheets("Receivables").Range("I" & z_f + 19)
r = r + 4
End If
Else
If CDbl(Sheets("Receivables").Range("H" & z_f + 19)) <> CDbl(Sheets("payables").Range("H" & z_v + 19)) * -1 Then
If LCase(Sheets("Receivables").Range("I" & z_f + 19)) <> LCase(Sheets("payables").Range("I" & z_v + 19)) Then
'Beleg gleich, Datum gleich, Betrag ungleich, Währung ungleich
msg = MsgBox("Currency not equal, ext. account no. " & Sheets("payables").Range("C" & z_v + 19), vbOKOnly + vbInformation, "Different Currency")
Sheets("Reconciliation").Range("B" & r) = Sheets("Receivables").Range("C" & z_f + 19)
Sheets("Reconciliation").Range("C" & r) = Sheets("Receivables").Range("E" & z_f + 19)
Sheets("Reconciliation").Range("D" & r) = Sheets("Receivables").Range("H" & z_f + 19)
Sheets("Reconciliation").Range("E" & r) = Sheets("Receivables").Range("I" & z_f + 19)
Sheets("Reconciliation").Range("F" & r) = Sheets("Receivables").Range("J" & z_f + 19)
Sheets("Reconciliation").Range("B" & r + 1) = Sheets("payables").Range("C" & z_v + 19)
Sheets("Reconciliation").Range("C" & r + 1) = Sheets("payables").Range("E" & z_v + 19)
Sheets("Reconciliation").Range("D" & r + 1) = Sheets("payables").Range("H" & z_v + 19)
Sheets("Reconciliation").Range("E" & r + 1) = Sheets("payables").Range("I" & z_v + 19)
Sheets("Reconciliation").Range("F" & r + 1) = Sheets("payables").Range("J" & z_v + 19)
Sheets("Reconciliation").Range("D" & r + 2) = CDbl(Sheets("Receivables").Range("H" & z_f + 19)) + CDbl(Sheets("payables").Range("H" & z_v + 19))
Sheets("Reconciliation").Range("E" & r + 2) = "not equal"
Else
'Beleg gleich, Datum gleich, Betrag ungleich, Währung gleich
Sheets("Reconciliation").Range("B" & r) = Sheets("Receivables").Range("C" & z_f + 19)
Sheets("Reconciliation").Range("C" & r) = Sheets("Receivables").Range("E" & z_f + 19)
Sheets("Reconciliation").Range("D" & r) = Sheets("Receivables").Range("H" & z_f + 19)
Sheets("Reconciliation").Range("E" & r) = Sheets("Receivables").Range("I" & z_f + 19)
Sheets("Reconciliation").Range("F" & r) = Sheets("Receivables").Range("J" & z_f + 19)
Sheets("Reconciliation").Range("B" & r + 1) = Sheets("payables").Range("C" & z_v + 19)
Sheets("Reconciliation").Range("C" & r + 1) = Sheets("payables").Range("E" & z_v + 19)
Sheets("Reconciliation").Range("D" & r + 1) = Sheets("payables").Range("H" & z_v + 19)
Sheets("Reconciliation").Range("E" & r + 1) = Sheets("payables").Range("I" & z_v + 19)
Sheets("Reconciliation").Range("F" & r + 1) = Sheets("payables").Range("J" & z_v + 19)
Sheets("Reconciliation").Range("D" & r + 2) = CDbl(Sheets("Receivables").Range("H" & z_f + 19)) + CDbl(Sheets("payables").Range("H" & z_v + 19))
Sheets("Reconciliation").Range("E" & r + 2) = Sheets("Receivables").Range("I" & z_f + 19)
r = r + 4
End If
Else
'Beleg gleich, Datum gleich, Betrag gleich, Währung ungleich
If LCase(Sheets("Receivables").Range("I" & z_f + 19)) <> LCase(Sheets("payables").Range("I" & z_v + 19)) Then
Sheets("Reconciliation").Range("B" & r) = Sheets("Receivables").Range("C" & z_f + 19)
Sheets("Reconciliation").Range("C" & r) = Sheets("Receivables").Range("E" & z_f + 19)
Sheets("Reconciliation").Range("D" & r) = Sheets("Receivables").Range("H" & z_f + 19)
Sheets("Reconciliation").Range("E" & r) = Sheets("Receivables").Range("I" & z_f + 19)
Sheets("Reconciliation").Range("F" & r) = Sheets("Receivables").Range("J" & z_f + 19)
Sheets("Reconciliation").Range("B" & r + 1) = Sheets("payables").Range("C" & z_v + 19)
Sheets("Reconciliation").Range("C" & r + 1) = Sheets("payables").Range("E" & z_v + 19)
Sheets("Reconciliation").Range("D" & r + 1) = Sheets("payables").Range("H" & z_v + 19)
Sheets("Reconciliation").Range("E" & r + 1) = Sheets("payables").Range("I" & z_v + 19)
Sheets("Reconciliation").Range("F" & r + 1) = Sheets("payables").Range("J" & z_v + 19)
Sheets("Reconciliation").Range("D" & r + 2) = CDbl(Sheets("Receivables").Range("H" & z_f + 19)) + CDbl(Sheets("payables").Range("H" & z_v + 19))
Sheets("Reconciliation").Range("E" & r + 2) = "not equal"
r = r + 4
'Else
'Beleg gleich, Datum gleich, Betrag gleich, Währung gleich => UNINTERESSANT
End If
End If
End If
'Else
'Beleg ungleich ==> UNINTERESSANT
End If
Next
Next
'Fehlende Eintragen
'Receivables ohne Verbindlichkeiten
i_f = 19
Do While Sheets("Receivables").Range("B" & i_f) <> ""
If Sheets("Receivables").Range("D" & i_f) <> "X" Then
Sheets("Reconciliation").Range("B" & r) = Sheets("Receivables").Range("C" & i_f)
Sheets("Reconciliation").Range("C" & r) = Sheets("Receivables").Range("E" & i_f)
Sheets("Reconciliation").Range("D" & r) = Sheets("Receivables").Range("H" & i_f)
Sheets("Reconciliation").Range("E" & r) = Sheets("Receivables").Range("I" & i_f)
Sheets("Reconciliation").Range("F" & r) = Sheets("Receivables").Range("J" & i_f)
Sheets("Reconciliation").Range("B" & r + 2) = "payab. missing"
Sheets("Reconciliation").Range("C" & r + 2) = "missing"
Sheets("Reconciliation").Range("D" & r + 2) = Sheets("Receivables").Range("H" & i_f) * -1
Sheets("Reconciliation").Range("E" & r + 2) = "missing"
Sheets("Reconciliation").Range("F" & r + 2) = "missing"
r = r + 4
End If
i_f = i_f + 1
Loop
'Verbindlichkeiten ohne Receivables
i_v = 19
Do While Sheets("payables").Range("B" & i_v) <> ""
If Sheets("payables").Range("D" & i_v) <> "X" Then
Sheets("Reconciliation").Range("B" & r + 1) = Sheets("payables").Range("C" & i_v)
Sheets("Reconciliation").Range("C" & r + 1) = Sheets("payables").Range("E" & i_v)
Sheets("Reconciliation").Range("D" & r + 1) = Sheets("payables").Range("H" & i_v)
Sheets("Reconciliation").Range("E" & r + 1) = Sheets("payables").Range("I" & i_v)
Sheets("Reconciliation").Range("F" & r + 1) = Sheets("payables").Range("J" & i_v)
Sheets("Reconciliation").Range("B" & r + 2) = "receiv. missing"
Sheets("Reconciliation").Range("C" & r + 2) = "missing"
Sheets("Reconciliation").Range("D" & r + 2) = Sheets("payables").Range("H" & i_v) * -1
Sheets("Reconciliation").Range("E" & r + 2) = "missing"
Sheets("Reconciliation").Range("F" & r + 2) = "missing"
r = r + 4
End If
i_v = i_v + 1
Loop
'Prüfen überhaupt Unstimmigkeiten gefunden, wenn nein Infomeldung
If r <= 19 Then
msg = MsgBox("No differences found.", vbInformation + vbOKOnly, "Great!")
End If
'Kennzeichen zur Erkennung fehlender Ford. bzw. Verb. löschen
Sheets("payables").Range("D19:D9999").ClearContents
Sheets("Receivables").Range("D19:D9999").ClearContents
ActiveWorkbook.Save
Sheets("Reconciliation").Activate
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
errorhandling:
msg = MsgBox("ERROR! Please contact a ITA-2 or CCA-51 employee and note the following information." & vbCr & vbCr & Err.Number & " - " & Err.Description, vbCritical + vbOKOnly, "Error")
Application.StatusBar = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End
End Sub