Sub Raport()
Dim Answer As String
Dim MyNote As String

    'Place your text here
    MyNote = "Obliczenia mogą potrwać kilka minut, dane w arkuszu Wynik zostaną usunięte. Kontynuować?"

    'Display MessageBox
    Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Uwaga!")

    If Answer = vbNo Then
        'Code for No button Press
       ' MsgBox "You pressed NO!"
    Else
        'Code for Yes button Press
       Call czescA
    End If

End Sub

Private Sub czescA()
Application.ScreenUpdating = False

'Sprawdzamy czy istnieje arkusz "wynik"
    nazwa = "Wynik"
    On Error Resume Next
    x = Worksheets(nazwa).Name
     If Not Err.Number = 0 Then
            'nieisnieje
            Sheets.Add.Name = nazwa
     End If

'Sprawdzamy czy istnieje arkusz "Raport"
    nazwa = "Raport"
    On Error Resume Next
    x = Worksheets(nazwa).Name
     If Not Err.Number = 0 Then
            'nieisnieje
            Sheets.Add.Name = nazwa
     End If
'Sprawdzamy czy istnieje arkusz "Dane"
    nazwa = "Dane"
    On Error Resume Next
    x = Worksheets(nazwa).Name
     If Not Err.Number = 0 Then
            'nieisnieje
            Sheets.Add.Name = nazwa
     End If
Sheets("Dane").Activate
'Sprawdzamy czy istnieje arkusz "Bledy"
    nazwa = "Bledy"
    On Error Resume Next
    x = Worksheets(nazwa).Name
     If Not Err.Number = 0 Then
            'nieisnieje
            Sheets.Add.Name = nazwa
     End If


'data uruchomienia
    Columns("k:k").TextToColumns Destination:=Range("Ap1"), DataType:=xlFixedWidth _
        , OtherChar:=" ", FieldInfo:=Array(Array(0, 2), Array(10, 9)), _
        TrailingMinusNumbers:=True
    Range("Ap1") = "data uruchomienia"
'data modyfikacji
    Columns("N:N").TextToColumns Destination:=Range("Aq1"), DataType:=xlFixedWidth _
            , OtherChar:=" ", FieldInfo:=Array(Array(0, 2), Array(10, 9)), _
            TrailingMinusNumbers:=True
    Range("Aq1") = "data modyfikacji"

'data od
    Columns("O:O").TextToColumns Destination:=Range("Ar1"), DataType:=xlFixedWidth _
            , OtherChar:=" ", FieldInfo:=Array(Array(0, 2), Array(10, 9)), _
            TrailingMinusNumbers:=True
    Range("Ar1") = "data od"
'##########
Range("as:at").Clear
Sheets("Wynik").Range("a:az").Clear
'1############### rozbiór daty uruchomienia
Set IdentNr = Range("h1")
Set TypKlienta = Range("h1")
Set DlugoscOdcinka = Range("i1")
Set rabat1 = Range("u1")
Set Abonament = Range("x1")
Set Kilometr = Range("y1")
Set Uruchomieniowa = Range("z1")
Set rabat2 = Range("ag1")
Set rabat3 = Range("ah1")
Set rabat4 = Range("ai1")
Set Duruchomienia = Range("ap1")
Set Dmodyfikacji = Range("aq1")
Set Dod = Range("ar1")
Set WypiszWynik = Range("as1") 'sam abonament
Set WypiszUruchomieniowa = Range("at1") 'sama uruchomieniowa
Set Status = Range("au1")
        
        c = 1
        b = 1
        
Do While IdentNr.Offset(b, 0) <> Empty

    a = b
    czymulti = 1
    Do While IdentNr.Offset(a, 0) <> Empty
        If IdentNr.Offset(b, 0) = IdentNr.Offset(a, 0) And b <> a Then
            czymulti = czymulti + 1 'liczymy czy łącze wieloodcinkowe dla danego b
        End If
        a = a + 1
    Loop
   If b = 3 Then
        xx = 1
        End If
    If czymulti > 1 Then
        
        a = b
        Do While IdentNr.Offset(a, 0) <> Empty
            If IdentNr.Offset(b, 0) = IdentNr.Offset(a, 0) And WypiszWynik.Offset(a, 0) = Empty Then
                Call wyliczenia(b, a, c, d)
                licz = licz + 1
            End If
            a = a + 1
        Loop
    Else
        If Range("as1").Offset(b, 0) = Empty Then
            Range("AW1").Offset(b, 0) = "Pojedynczy przypadek (w kolumnie h), wiersz: " & b
        End If
    End If
    b = b + 1
    licz = 0
Loop

'Dim Answer As String
'Dim MyNote As String
'    MyNote = "Czy wykonać raport?"
'    Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "???")
'    If Answer = vbNo Then
'        MsgBox "Autor: Wojciech Arabski, warabski@gmial.com"
'    Else
        
        Call czescB
'    End If

End Sub

Private Sub wyliczenia(b, a, c, d)

Set IdentNr = Range("h1")
'Set TypKlienta = Range("h1")
Set DlugoscOdcinka = Range("i1")
Set Duruchomienia = Range("ap1")
Set Dmodyfikacji = Range("aq1")
Set Dod = Range("ar1")
Set rabat1 = Range("u1")
Set SP_NALICZ_MIN = Range("v1")
Set SP_NALICZ_MAX = Range("w1")
Set Abonament = Range("x1")
Set Kilometr = Range("y1")
Set Uruchomieniowa = Range("z1")
Set rabat2 = Range("ag1")
Set rabat3 = Range("ah1")
Set rabat4 = Range("ai1")
Set WypiszWynik = Range("as1") 'sam abonament
Set WypiszUruchomieniowa = Range("at1") 'sama uruchomieniowa
Set Status = Range("au1")
        
        If SP_NALICZ_MIN.Offset(a, 0) = 0 And SP_NALICZ_MAX.Offset(a, 0) = 0 Then
            DlugoscOdcinkaOD = 0
            DlugoscOdcinkaDO = 999999999
        End If
        If SP_NALICZ_MIN.Offset(a, 0) >= 0 And SP_NALICZ_MAX.Offset(a, 0) > 0 Then
            DlugoscOdcinkaOD = SP_NALICZ_MIN.Offset(a, 0)
            DlugoscOdcinkaDO = SP_NALICZ_MAX.Offset(a, 0)
        End If
        If SP_NALICZ_MIN.Offset(a, 0) > 0 And SP_NALICZ_MAX.Offset(a, 0) = 0 Then
            DlugoscOdcinkaOD = SP_NALICZ_MIN.Offset(a, 0)
            DlugoscOdcinkaDO = 999999999
        End If
            If DlugoscOdcinka.Offset(a, 0) > 0 Then
               ' Range("AW1").Offset(a, 0) = "Długość odcinka = 0"
            
            If (DlugoscOdcinka.Offset(a, 0) >= DlugoscOdcinkaOD And DlugoscOdcinka.Offset(a, 0) < DlugoscOdcinkaDO) Then
                'rozbiór daty uruchomienia
                For i = 1 To 3
                    znak = Mid(Duruchomienia.Offset(a, 0), i, 1)
                    If znak = "/" Then
                       DUmc = Mid(Duruchomienia.Offset(a, 0), 1, i - 1)
                       'DUmc = DUmc + 0
                       Exit For
                    End If
                Next
                For j = i + 1 To i + 3
                    znak = Mid(Duruchomienia.Offset(a, 0), j, 1)
                    If znak = "/" Then
                       DUdd = Mid(Duruchomienia.Offset(a, 0), i + 1, j - (i + 1))
                       'DUdd = DUdd + 0
                       Exit For
                    End If
                Next
                For k = j To j + 3
                    znak = Mid(Duruchomienia.Offset(a, 0), k, 1)
                    If znak = "/" Then
                       DUrr = Mid(Duruchomienia.Offset(a, 0), k + 1, k)
                       'DUrr = DUrr + 0
                       Exit For
                    End If
                Next
                DUsummc = (DUrr - 1 * 12) + DUmc
                '1fin###
                '2############### rozbiór daty modyfikacji
                    For i = 1 To 3
                        znak = Mid(Dmodyfikacji.Offset(a, 0), i, 1)
                        If znak = "/" Then
                           DMmc = Mid(Dmodyfikacji.Offset(a, 0), 1, i - 1)
                          ' DMmc = DMmc + 0
                           Exit For
                        End If
                    Next
                    For j = i + 1 To i + 3
                        znak = Mid(Dmodyfikacji.Offset(a, 0), j, 1)
                        If znak = "/" Then
                           DMdd = Mid(Dmodyfikacji.Offset(a, 0), i + 1, j - (i + 1))
                          ' DMdd = DMdd + 0
                           Exit For
                        End If
                    Next
                    For k = j To j + 3
                        znak = Mid(Dmodyfikacji.Offset(a, 0), k, 1)
                        If znak = "/" Then
                            DMrr = Mid(Dmodyfikacji.Offset(a, 0), k + 1, k)
                           ' DMrr = DMrr + 0
                            Exit For
                        End If
                    Next
                    DMsummc = (DMrr - 1 * 12) + DMmc
                '2fin###
                '3############### rozbiór daty OD
                    For i = 1 To 3
                        znak = Mid(Dod.Offset(a, 0), i, 1)
                        If znak = "/" Then
                           DOmc = Mid(Dod.Offset(a, 0), 1, i - 1)
                           'DOmc = DOmc + 0
                           Exit For
                        End If
                    Next
                    For j = i + 1 To i + 3
                        znak = Mid(Dod.Offset(a, 0), j, 1)
                        If znak = "/" Then
                           DOdd = Mid(Dod.Offset(a, 0), i + 1, j - (i + 1))
                           'DOdd = DOdd + 0
                           Exit For
                        End If
                    Next
                    For k = j To j + 3
                        znak = Mid(Dod.Offset(a, 0), k, 1)
                        If znak = "/" Then
                            DOrr = Mid(Dod.Offset(a, 0), k + 1, k)
                            'DOrr = DOrr + 0
                            Exit For
                        End If
                    Next
                    DOsummc = (DOrr - 1 * 12) + DOmc
                'Obliczenie sumy czterech rabatów
                '    Set rabat1 = Range("u1")
                '    Set rabat2 = Range("ag1")
                '    Set rabat3 = Range("ah1")
                '    Set rabat4 = Range("ai1")
                    RabatSum = rabat1.Offset(a, 0) + rabat2.Offset(a, 0) + rabat3.Offset(a, 0) + rabat4.Offset(a, 0)
    
           '#################
            'rozisanie przypadków
            DoZap = 0
                'nowy przypadek 1
                
               ' If DUsummc + 1 = DMsummc And DUsummc + 3 >= DMsummc Then
                    'Przypadek 1a: K+1>= N  =O -opłata za instalacyjna + opłata abonamentowa za miesiąc K ( proreting)+ opłata abonamentowa za miesiąc N
                    If DUsummc + 1 = DMsummc And DUsummc + 1 = DOsummc Then
                            If DoZap = 0 Then
                                Range("av1").Offset(a, 0) = "Przypadek1a"
                                'wypisanie opłaty uruchomienowej:
                                    WypiszUruchomieniowa.Offset(a, 0) = Uruchomieniowa.Offset(a, 0)
                                'opłata abonamentowa za miesiąc K ( proreting):
                                    DuIloscdni = 31 - DUdd
                                    DuDoZapAbonamentK = DuIloscdni * Abonament.Offset(a, 0) / 30
                                    DuDoZapKmK = (DuIloscdni * Kilometr.Offset(a, 0) / 30) * DlugoscOdcinka.Offset(a, 0)
                                'opłata abonamentowa za miesiąc N:
                                    'DmIloscdni = 30
                                    DmDoZapAbonamentN = Abonament.Offset(a, 0)
                                    DmDoZapKmN = Kilometr.Offset(a, 0) * DlugoscOdcinka.Offset(a, 0)
                                'Obliczenie kwoty do zapłaty:
                                    sumaDoZap = DuDoZapAbonamentK + DuDoZapKmK + DmDoZapAbonamentN + DmDoZapKmN
                                'Zaokrąglenie do dwuch miejsc po przecinku:
                            
                                DoZap = Round(sumaDoZap, 2)
                                'wypisanie wyniku:
                                WypiszWynik.Offset(a, 0) = DoZap
                            Else
                                Sheets("Bledy").Range("a1").Offset(d, 0) = "bląd, komórka DoZap w przypadku 1a nie jest równa 0 dla wiersza" & a + 1
                                Sheets("Bledy").Range("a1").Offset(d, 1) = Range("av1").Offset(a, 0)
                                d = d + 1
                            End If
                        
                    End If
                    
                    'Przypadek 1b: K+2  >=   N  =  O  - opłata instalacyjna + opłata abonamentowa za miesiąc K (proreting)   + opłata abonamentowa za misiąc (K+1) + opłata abonamentowa za miesiąc (K+2)
                     If DUsummc + 2 >= DMsummc And DUsummc + 2 = DOsummc Then
                            If DoZap = 0 Then
                                Range("av1").Offset(a, 0) = "Przypadek1b"
            
                                'wypisanie opłaty uruchomienowej:
                                    WypiszUruchomieniowa.Offset(a, 0) = Uruchomieniowa.Offset(a, 0)
                                'opłata abonamentowa za miesiąc K ( proreting):
                                    DuIloscdni = 31 - DUdd
                                    DuDoZapAbonamentK = DuIloscdni * Abonament.Offset(a, 0) / 30
                                    DuDoZapKmK = (DuIloscdni * Kilometr.Offset(a, 0) / 30) * DlugoscOdcinka.Offset(a, 0)
                                'opłata abonamentowa za miesiąc K+1:
                                    'DuIloscdni = 30
                                    DuDoZapAbonamentK1 = Abonament.Offset(a, 0)
                                    DuDoZapKmK1 = Kilometr.Offset(a, 0) * DlugoscOdcinka.Offset(a, 0)
                                'opłata abonamentowa za miesiąc K+2:
                                    'DuIloscdni = 30
                                    DuDoZapAbonamentK2 = Abonament.Offset(a, 0)
                                    DuDoZapKmK2 = Kilometr.Offset(a, 0) * DlugoscOdcinka.Offset(a, 0)
                                'Obliczenie kwoty do zapłaty:
                                    sumaDoZap = DuDoZapAbonamentK + DuDoZapKmK + DuDoZapAbonamentK1 + DuDoZapKmK1 + DuDoZapAbonamentK2 + DuDoZapKmK2
                                'Zaokrąglenie do dwuch miejsc po przecinku:
                            
                                DoZap = Round(sumaDoZap, 2)
                                'wypisanie wyniku:
                                WypiszWynik.Offset(a, 0) = DoZap
                            Else
                                Sheets("Bledy").Range("a1").Offset(d, 0) = "bląd, komórka DoZap w przypadku 1b nie jest równa 0 dla wiersza" & a + 1
                                Sheets("Bledy").Range("a1").Offset(d, 1) = Range("av1").Offset(a, 0)
                                d = d + 1
                            End If
                    End If
                    'Przypadek 1c: K +3 >= N  =  O- opłata instalacyjna + opłata abonamentowa za misiąc K (proreting) + opłata abonamentowa za misiąc (K+1)+ opłata abonamentowa za misiąc (K+2)+ opłata abonamentowa za miesiąc (K+3)
                     If DUsummc + 3 >= DMsummc And DUsummc + 3 = DOsummc Then
                            If DoZap = 0 Then
                               Range("av1").Offset(a, 0) = "Przypadek 1c"
                            
                               'wypisanie opłaty uruchomienowej:
                                   WypiszUruchomieniowa.Offset(a, 0) = Uruchomieniowa.Offset(a, 0)
                               'opłata abonamentowa za miesiąc K ( proreting):
                                   DuIloscdni = 31 - DUdd
                                   DuDoZapAbonamentK = DuIloscdni * Abonament.Offset(a, 0) / 30
                                   DuDoZapKmK = (DuIloscdni * Kilometr.Offset(a, 0) / 30) * DlugoscOdcinka.Offset(a, 0)
                               'opłata abonamentowa za miesiąc K+1:
                                   'DuIloscdni = 30
                                   DuDoZapAbonamentK1 = Abonament.Offset(a, 0)
                                   DuDoZapKmK1 = Kilometr.Offset(a, 0) * DlugoscOdcinka.Offset(a, 0)
                               'opłata abonamentowa za miesiąc K+2:
                                   'DuIloscdni = 30
                                   DuDoZapAbonamentK2 = Abonament.Offset(a, 0)
                                   DuDoZapKmK2 = Kilometr.Offset(a, 0) * DlugoscOdcinka.Offset(a, 0)
                               'opłata abonamentowa za miesiąc (K+3)
                                   'DuIloscdni = 30
                                   DuDoZapAbonamentK3 = Abonament.Offset(a, 0)
                                   DuDoZapKmK3 = Kilometr.Offset(a, 0) * DlugoscOdcinka.Offset(a, 0)
                               'Obliczenie kwoty do zapłaty:
                                   sumaDoZap = DuDoZapAbonamentK + DuDoZapKmK + DuDoZapAbonamentK1 + DuDoZapKmK1 + DuDoZapAbonamentK2 + DuDoZapKmK2 + DuDoZapAbonamentK3 + DuDoZapKmK3
                               'Zaokrąglenie do dwuch miejsc po przecinku:
                            
                                DoZap = Round(sumaDoZap, 2)
                                'wypisanie wyniku:
                                WypiszWynik.Offset(a, 0) = DoZap
                            Else
                                Sheets("Bledy").Range("a1").Offset(d, 0) = "bląd, komórka DoZap w przypadku 1c nie jest równa 0 dla wiersza" & a + 1
                                Sheets("Bledy").Range("a1").Offset(d, 1) = Range("av1").Offset(a, 0)
                                d = d + 1
                            End If
                        End If
                'Koniec nowy przypdek 1
              '  End If
                
                'Nowy przypadek 2
                'K = N  =O    opłata instalacyjana + opłata abonamentowa
                If DUsummc = DMsummc And DUsummc = DOsummc Then
                     If DoZap = 0 Then
                            Range("av1").Offset(a, 0) = "Przypadek 2"
            
                            'opłata abonamentowa za miesiąc K:
                                DuDoZapAbonamentK = Abonament.Offset(a, 0)
                                DuDoZapKmK = Kilometr.Offset(a, 0) * DlugoscOdcinka.Offset(a, 0)
                            'Obliczenie kwoty do zapłaty:
                                sumaDoZap = DuDoZapAbonamentK + DuDoZapKmK
                            'Zaokrąglenie do dwuch miejsc po przecinku:
                       
                            DoZap = Round(sumaDoZap, 2)
                            'wypisanie wyniku:
                                WypiszWynik.Offset(a, 0) = DoZap
                        Else
                            Sheets("Bledy").Range("a1").Offset(d, 0) = "bląd, komórka DoZap w przypadku 2 nie jest równa 0 dla wiersza" & a + 1
                            Sheets("Bledy").Range("a1").Offset(d, 1) = Range("av1").Offset(a, 0)
                            d = d + 1
                        End If
                'Koniec Nowy przypadek 2
                End If
                
                'Nowy przypadek 3 A
                '(K + 1= N i N < O )   opłata instalacyjna + opłata abonament czerwiec(prorating), opłata abonament lipiec, opłata abonament sierpień, opłata abonament wrzesień
                If DUsummc + 1 = DMsummc And DMsummc < DOsummc Then
                    If DoZap = 0 Then
                            Range("av1").Offset(a, 0) = "Przypadek 3a"
                            'wypisanie opłaty uruchomienowej:
                                WypiszUruchomieniowa.Offset(a, 0) = Uruchomieniowa.Offset(a, 0)
                            'opłata abonament czerwiec(prorating) (miesiąc K)
                                DuIloscdni = 31 - DUdd
   &