Option Explicit
Option Base 1

Public Sub autocorr()
    Dim Rng As Range, Lags As Integer, TimeSeries() As Double, i As Long, Diff As Boolean, DiffTimeSeries() As Double
    Dim Aver As Double, MeanTimeSeries() As Double, ACF() As Double, PACF() As Double, ACFMatrix() As Double
    Dim j As Integer, k As Integer, Count As Integer, Top() As Double, Bottom() As Double
    Dim Squares() As Double, SumOfSquares As Double
    Dim ACFSource As Object, PACFSource As Object, wb As Workbook, StErrMethod As Boolean
    Set Rng = Application.InputBox("Choose Baseline Range", "Autocorrelation", "$A$1:$A$69", , , , , 8)
    If Rng Is Nothing Then Exit Sub
    ReDim TimeSeries(Rng.Rows.Count, 1)
    For i = LBound(TimeSeries) To UBound(TimeSeries)
        TimeSeries(i, 1) = Rng.Offset(i - 1, 0).Resize(1, 1)
    Next
    Lags = Application.InputBox("Choose Lags Count. Default: 20", "Autocorrelation", 20, , , , , 1)
    If Lags < 1 Or Lags >= UBound(TimeSeries) Then Exit Sub
    Diff = Application.InputBox("Make First Non-Season Differencing? 0 - No; 1 - Yes", "Autocorrelation", False, , , , , 4)

    If TypeName(Diff) <> "Boolean" Then Exit Sub
    If Diff = True Then
        ReDim DiffTimeSeries(UBound(TimeSeries) - 1, 1)
        For i = LBound(TimeSeries) To UBound(TimeSeries) - 1
            DiffTimeSeries(i, 1) = TimeSeries(i + 1, 1) - TimeSeries(i, 1)
        Next
        ReDim TimeSeries(UBound(DiffTimeSeries), 1)
        For i = LBound(DiffTimeSeries) To UBound(DiffTimeSeries)
            TimeSeries(i, 1) = DiffTimeSeries(i, 1)
        Next i
    End If
    StErrMethod = Application.InputBox("Standard Error Method: 0 - 'Bartlett's approximation; 1 - Independence Method", "Autocorrelation", False, , , , , 4)
    If TypeName(StErrMethod) <> "Boolean" Then Exit Sub

    ' Calculating ACF and PACF
    ReDim MeanTimeSeries(UBound(TimeSeries))
    ReDim ACFMatrix(Lags, Lags)
    ReDim ACF(Lags, 4)
    ReDim PACF(Lags, 4)

    Aver = Application.WorksheetFunction.Average(TimeSeries)

    For i = LBound(TimeSeries) To UBound(TimeSeries)
        MeanTimeSeries(i) = TimeSeries(i, 1) - Aver
    Next

    Aver = (Application.WorksheetFunction.SumSq(MeanTimeSeries) / UBound(TimeSeries)) * UBound(TimeSeries)

    For i = 1 To Lags
        For j = 1 To UBound(TimeSeries) - i
            ACF(i, 1) = ACF(i, 1) + MeanTimeSeries(j) * MeanTimeSeries(j + i)
        Next
        ACF(i, 1) = ACF(i, 1) / Aver
    Next

    For i = 1 To Lags
        Count = 1
        For j = i To Lags
            If j = i Then
                ACFMatrix(i, j) = 1
            Else
                ACFMatrix(i, j) = ACF(Count, 1)
                ACFMatrix(j, i) = ACF(Count, 1)
                Count = Count + 1
            End If
        Next
    Next

    PACF(1, 1) = ACF(1, 1)

    For k = 2 To Lags
        ReDim Top(k, k)
        ReDim Bottom(k, k)
        For i = 1 To k
            For j = 1 To k
                Top(i, j) = ACFMatrix(i, j)
                Bottom(i, j) = ACFMatrix(i, j)
            Next
        Next
        For i = 1 To k
            Top(i, k) = ACF(i, 1)
        Next
        PACF(k, 1) = Application.WorksheetFunction.MDeterm(Top) / Application.MDeterm(Bottom)
    Next

    ' Calculating standard errors

    ' Bartlett's approximation

    If StErrMethod = False Then
        ReDim Squares(0 To Lags)

        Squares(0) = 0

        For i = 1 To Lags
            Squares(i) = ACF(i, 1) ^ 2
        Next

        For i = 1 To Lags
            SumOfSquares = 0
            For j = 0 To i - 1
                SumOfSquares = SumOfSquares + Squares(j)
            Next
            ACF(i, 2) = Sqr(1 / UBound(TimeSeries) * (1 + 2 * SumOfSquares))
            ACF(i, 3) = 2 * ACF(i, 2)
            ACF(i, 4) = -1 * ACF(i, 3)
        Next
    Else

        ' Independence Method
        For i = 1 To Lags
            ACF(i, 2) = Sqr(1 / UBound(TimeSeries) * (UBound(TimeSeries) - i) / (UBound(TimeSeries) + 2))
            ACF(i, 3) = 2 * ACF(i, 2)
            ACF(i, 4) = -1 * ACF(i, 3)
        Next
    End If

    ' PACF Standard Errors
    For i = 1 To Lags
        PACF(i, 2) = (1 / Sqr(UBound(TimeSeries)))
        PACF(i, 3) = 2 * PACF(i, 2)
        PACF(i, 4) = -1 * PACF(i, 3)
    Next

    ' Creating a new workbook
    Set wb = Workbooks.Add()
    wb.SaveAs Filename:=ThisWorkbook.Path & "\Correlograms.xlsx"
    wb.Sheets(1).Name = "Data"
    Cells(1, 1) = "Autocorrelation"
    Cells(1, 2) = "ACF Standard Error. Method: " & Str(Val(StErrMethod))
    Cells(1, 3) = "ACF Upper Confidence Limit"
    Cells(1, 4) = "ACF Lower Confidence Limit"
    Cells(1, 5) = "Partial Autocorrelation"
    Cells(1, 6) = "PACF Standard Error"
    Cells(1, 7) = "PACF Upper Confidence Limit"
    Cells(1, 8) = "PACF Lower Confidence Limit"
    For i = 2 To Lags + 1
        Cells(i, 1) = ACF(i - 1, 1)
        Cells(i, 2) = ACF(i - 1, 2)
        Cells(i, 3) = ACF(i - 1, 3)
        Cells(i, 4) = ACF(i - 1, 4)
        Cells(i, 5) = PACF(i - 1, 1)
        Cells(i, 6) = PACF(i - 1, 2)
        Cells(i, 7) = PACF(i - 1, 3)
        Cells(i, 8) = PACF(i - 1, 4)
    Next

    ' Drawing correlograms

    With Sheets("Data")
        Set ACFSource = Application.Union(.Range(Cells(2, 1), Cells(Lags + 1, 1)), .Range(Cells(2, 3), Cells(Lags + 1, 4)))
        Set PACFSource = Application.Union(.Range(Cells(2, 5), Cells(Lags + 1, 5)), .Range(Cells(2, 7), Cells(Lags + 1, 8)))
    End With
    Charts.Add
    ActiveSheet.Name = "ACF"
    ActiveChart.ChartWizard Source:=ACFSource, _
                            Gallery:=xlColumn, Format:=1, PlotBy:=xlColumns, _
                            CategoryLabels:=0, SeriesLabels:=0, HasLegend:=2, Title:= _
                            "ACF", CategoryTitle:="", ValueTitle:="", ExtraTitle:=""
    FormatGraph
    Charts.Add
    ActiveSheet.Name = "PACF"
    ActiveChart.ChartWizard Source:=PACFSource, _
                            Gallery:=xlColumn, Format:=1, PlotBy:=xlColumns, _
                            CategoryLabels:=0, SeriesLabels:=0, HasLegend:=2, Title:= _
                            "PACF", CategoryTitle:="", ValueTitle:="", ExtraTitle:=""
    FormatGraph
    Sheets("ACF").Activate
End Sub

Private Sub FormatGraph()
With ActiveChart
    .SeriesCollection(2).Select
    Selection.Type = xlLine
    .SeriesCollection(2).Select
    With Selection.Border
        .Weight = xlThin
        .LineStyle = xlNone
    End With
    With Selection
        .MarkerBackgroundColorIndex = 1
        .MarkerForegroundColorIndex = 1
        .MarkerStyle = xlDash
        .Smooth = False
    End With
    .SeriesCollection(3).Select
    Selection.Type = xlLine
    .SeriesCollection(3).Select
    With Selection.Border
        .Weight = xlThin
        .LineStyle = xlNone
    End With
    With Selection
        .MarkerBackgroundColorIndex = 1
        .MarkerForegroundColorIndex = 1
        .MarkerStyle = xlDash
        .Smooth = False
    End With
    .Deselect
End With
End Sub