Attribute VB_Name = "SalesReport"
Sub SalesReport()

'
' SalesReport
'

'********************************
' Meldungen, Screen Aktualisierung und Makros aktivieren vermeiden
'********************************
    
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False

'Workbooks, Worksheets, Filedialog, Sheettarget deklarieren
Dim WBVorlage As Workbook
Dim oFileDialog As FileDialog
Dim ThisSalesMan As String
Dim SalesType As Integer
Dim actSheet As Worksheet
Dim dataSheet As Worksheet

'Variablen für Messename
Dim sName As String
Dim lPos As Long
Dim Messe As String

'Vergleichsvariablen
Dim nameLeftExist As Integer
Dim nameRightExist As Integer

'Werte für Status deklarieren D
Dim openV As Integer
Dim aquiV As Integer
Dim leadV As Integer
Dim lostV As Integer
Dim soldV As Integer
Dim decisionOpenV As Integer
Dim inProcess As Integer
Dim complete As Integer

'Zähler deklarieren
Dim iRow As Integer
Dim vRow As Integer
Dim lastRow As Integer

'prüfen ob neues oder vorhandenes Workbook nutzen
Dim msg As String
Dim buttonNew As Integer
Dim Answer As Variant

'Abfrage für Sales oder Adsales
SalesType = InputBox("Geben Sie den Verkaufstyp an: Sales = 1 | Adsales = 2", "Sales Type!")

If SalesType < "1" Then
    MsgBox "Please choose the sales type first! Try it again"
    Exit Sub
End If

msg = "Vorhandene Datei nutzen = Ja | Neue Datei = Nein"
MsgTitle = "Offene Datei nutzen?"
' Bei Ja soll vorhandene Datei genutzt werden.
Answer = MsgBox(msg, vbQuestion + vbYesNoCancel, MsgTitle)
If Answer = vbNo Then
    Set oFileDialog = Application.FileDialog(msoFileDialogFilePicker)
    With oFileDialog
        .title = "Datei auswählen"
        .ButtonName = "Öffnen"
        .AllowMultiSelect = False
        If .Show = True Then
            Dim vItem As Variant
            For Each vItem In .SelectedItems
            'Verarbeitung starten
                Dim NewWB As Object
                Application.Workbooks.Open (vItem)
           Next
       End If
    End With
End If
If Answer = vbCancel Then
    Exit Sub
End If

'Aktuelles Workbook deklarieren
Set WBVorlage = ActiveWorkbook

'Formatsheet deklarieren
'Wenn Sheet Data Format nicht vorhanden ist neu anlegen
If Not WorksheetExists("Format Data", WBVorlage) Then
    Set WS = WBVorlage.Worksheets.Add
    WS.Name = "Format Data"
End If
Set dataSheet = WBVorlage.Worksheets("Format Data")

'Abfrage für welchen Verkäufer
ThisSalesMan = InputBox("Geben Sie die Initialen des Verkäufers an (Beispiel: tm)!", "Initialen eingeben!")

' Aus Clipboard Daten in Data Format kopieren
dataSheet.Activate
dataSheet.Cells.ClearContents
dataSheet.Cells(1, 1).Select
dataSheet.PasteSpecial Format:="Text", Link:=False

'Wenn Sheet Statistic nicht vorhanden ist neu anlegen
If Not WorksheetExists("Statistic " & ThisSalesMan, WBVorlage) Then
    Set WS = WBVorlage.Worksheets.Add
    WS.Name = "Statistic " & ThisSalesMan
End If

Set actSheet = WBVorlage.Worksheets("Statistic " & ThisSalesMan)
actSheet.Activate

' Alte Werte im entsprechenden Sheet von Links nach Rechts kopieren
countPageRows = actSheet.UsedRange.Rows.Count
actSheet.Range("C18:D" & countPageRows).Copy
actSheet.Range("A18:B" & countPageRows).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
actSheet.Range("C18:D" & countPageRows).ClearContents

' Messenamen ermitteln
sName = dataSheet.Cells(4, 1)
lPos = InStr(sName, " > ")
Messe = Mid(sName, lPos + 3)
actSheet.Cells(1, 1).Value = Messe
actSheet.Cells(1, 1).Font.Bold = True

' Ungenutzte Daten löschen
dataSheet.Rows("1:18").EntireRow.Delete
If SalesType = "1" Then
    dataSheet.Columns("E:F").EntireColumn.Delete
Else
    dataSheet.Columns("E:G").EntireColumn.Delete
End If

' unnötige Zeilen in Datasheet löschen
lastRow = dataSheet.Cells(Rows.Count, 1).End(xlUp).Row

' Neue Werte in entsprechendes Sheet einfügen
dataSheet.Range("D1:E" & lastRow).Copy
actSheet.Range("C18:D18").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
dataSheet.Delete

'Quervergleich und Anpassen der linken Spalte
countPageRows = actSheet.UsedRange.Rows.Count
If countPageRows < 19 Then
    countPageRows = countNewRows + 18
Else
    For iRow = countPageRows To 18 Step -1
        nameLeftExist = 0
        For vRow = 18 To countPageRows
            If actSheet.Cells(iRow, 1) = actSheet.Cells(vRow, 3) Then
                nameLeftExist = 1
            End If
        Next vRow
        If Not nameLeftExist = 1 And Not actSheet.Cells(iRow, 1) = "" Then
            ' MsgBox actSheet.Cells(iRow, 1) & " muss gelöscht werden"
            actSheet.Range("A" & iRow & ":B" & iRow).Delete Shift:=xlUp
        End If
    Next iRow
End If

' Quervergleich und Anpassen der rechten Spalte
countPageRows = actSheet.UsedRange.Rows.Count
If countPageRows < 19 Then
    countPageRows = countNewRows + 18
Else
    For iRow = 18 To countPageRows
        nameRightExist = 0
        For vRow = 18 To countPageRows
            If actSheet.Cells(iRow, 3) = actSheet.Cells(vRow, 1) Then
                nameRightExist = 1
            End If
        Next vRow
    
        If Not nameRightExist = 1 And Not actSheet.Cells(iRow, 3) = "" Then
            ' MsgBox actSheet.Cells(iRow, 3) & " muss kopiert werden"
            actSheet.Range("C" & iRow & ":D" & iRow).Copy
            actSheet.Range("A" & iRow & ":B" & iRow).Insert Shift:=xlDown
        End If
    Next iRow
End If

'Spalten A, B sortieren
Range("A18:B" & countPageRows).Select
    actSheet.Sort.SortFields.Clear
    actSheet.Sort.SortFields.Add Key:=Range( _
        "A18:A" & countPageRows), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With actSheet.Sort
        .SetRange Range("A18:B" & countPageRows)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'Spalten C,D sortieren
Range("C18:D" & countPageRows).Select
    actSheet.Sort.SortFields.Clear
    actSheet.Sort.SortFields.Add Key:=Range( _
        "C18:C" & countPageRows), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With actSheet.Sort
        .SetRange Range("C18:D" & countPageRows)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

For iRow = 18 To countPageRows
    
    'Werte in E und F automatisch füllen
    'E
    If actSheet.Cells(iRow, 2) = "Open" Then
        If actSheet.Cells(iRow, 4) = "Lead" Or actSheet.Cells(iRow, 4) = "Acquisition" Then
            actSheet.Cells(iRow, 5) = "1"
        Else
            actSheet.Cells(iRow, 5) = "0"
        End If
    Else
        actSheet.Cells(iRow, 5) = "0"
    End If
    'F
    If actSheet.Cells(iRow, 2) = "Open" Or actSheet.Cells(iRow, 2) = "Lead" Or actSheet.Cells(iRow, 2) = "Acquisition" Then
        If actSheet.Cells(iRow, 4) = "Sold" Or actSheet.Cells(iRow, 4) = "Lost" Or actSheet.Cells(iRow, 4) = "Sales Decision Open" Then
            actSheet.Cells(iRow, 6) = "1"
        Else
            actSheet.Cells(iRow, 6) = "0"
        End If
    Else
        actSheet.Cells(iRow, 6) = "0"
    End If
    
    'Anzahl der Werte auslesen
    If actSheet.Cells(iRow, 4) = "Open" Then
        openV = openV + 1
    End If
    If actSheet.Cells(iRow, 4) = "Acquisition" Then
        aquiV = aquiV + 1
    End If
    If actSheet.Cells(iRow, 4) = "Lead" Then
        leadV = leadV + 1
    End If
    If actSheet.Cells(iRow, 4) = "Lost" Then
        lostV = lostV + 1
    End If
    If actSheet.Cells(iRow, 4) = "Sold" Then
        soldV = soldV + 1
    End If
    If actSheet.Cells(iRow, 4) = "Sales Decision Open" Then
        decisionOpenV = decisionOpenV + 1
    End If
    If actSheet.Cells(iRow, 5) = "1" Then
        inProcess = inProcess + 1
    End If
    If actSheet.Cells(iRow, 6) = "1" Then
        complete = complete + 1
    End If
    
Next iRow
    
    actSheet.Cells(3, 2) = openV
    actSheet.Cells(4, 2) = aquiV
    actSheet.Cells(5, 2) = leadV
    actSheet.Cells(6, 2) = lostV
    actSheet.Cells(7, 2) = soldV
    actSheet.Cells(8, 2) = decisionOpenV
    actSheet.Cells(11, 2) = inProcess
    actSheet.Cells(15, 2) = complete
    
    actSheet.Cells(3, 1) = "Open"
    actSheet.Cells(4, 1) = "Acquisition"
    actSheet.Cells(5, 1) = "Lead"
    actSheet.Cells(6, 1) = "Lost"
    actSheet.Cells(7, 1) = "Sold"
    actSheet.Cells(8, 1) = "Decision Open"
    actSheet.Cells(11, 1) = "in process IST"
    actSheet.Cells(11, 1).Font.Bold = True
    actSheet.Cells(15, 1) = "complete IST"
    actSheet.Cells(15, 1).Font.Bold = True
    actSheet.Cells(16, 5) = "to i.p."
    actSheet.Cells(16, 5).Font.Bold = True
    actSheet.Cells(16, 6) = "to compl."
    actSheet.Cells(16, 6).Font.Bold = True

' unnötige Zeilen löschen
lastRow = actSheet.Cells(Rows.Count, 1).End(xlUp).Row
usedRows = actSheet.UsedRange.Rows.Count
If actSheet.Cells(lastRow, 1) = "" Or actSheet.Cells(lastRow, 1) = "=" Or actSheet.Cells(lastRow, 1) = " " Then
    actSheet.Range("A" & lastRow & ":A" & usedRows).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End If

If actSheet.Cells(18, 1).Value <> "" And actSheet.Cells(18, 3).Value <> "" Then
    actSheet.Range("A18:F18").Delete Shift:=xlUp
End If

actSheet.Cells.EntireColumn.AutoFit

' Workbook speichern
ActiveWorkbook.Save

actSheet.Activate
actSheet.Range("A1").Select
ActiveWindow.ScrollRow = "1"

End Sub