Sub AudioDataAnalysis()

    Application.ScreenUpdating = False
    Set startCell = ActiveCell

    'Convert delimited data to columns
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, Comma:=True

    MSG1 = MsgBox("Delete first and last measurements?", vbYesNo)
    If MSG1 = vbYes Then
         TrimFirstandLast
    End If

    Dim TimeRng As Range
    Dim searchstring As String
    Dim headers As Range
    Dim counter As Integer

    searchstring = "Time"
    Set TimeRng = ActiveSheet.Range("A1:ZZ10000").Find(searchstring, lookat:=xlPart)
    If TimeRng Is Nothing Then
        MsgBox "'" & searchstring & "' was not found."
        Exit Sub
    End If

    If Not TimeRng Is Nothing Then
        Set XL2 = ActiveSheet.Range("A1:ZZ10000").Find("XL2", lookat:=xlPart)

        If XL2 Is Nothing Then
    End If

    'This is a hack
        If Not XL2 Is Nothing Then
            Set TimeRng = ActiveSheet.Range("C23")
        End If
    End If


    'get data height------------------------
    Dim DataHeight As Integer
    DataHeight = 0

    Dim week As Integer
    Dim weekd As String
    Dim dd As String


    'go down to first value
    If Not XL2 Is Nothing Then
        TimeRng.Offset(2, -1).Activate
        week = Weekday(ActiveCell)
        weekd = WeekdayName(week - 1, 2)
        dd = CDate(ActiveCell.value)
        TimeRng.Offset(-1, 1).Activate
    Else
        TimeRng.Offset(1, 0).Activate
        week = Weekday(ActiveCell)
        weekd = WeekdayName(week - 1, 2)
        dd = CDate(ActiveCell.value)
    End If

    Do While Not ActiveCell.value = ""
        ActiveCell.Offset(1, 0).Activate
        DataHeight = DataHeight + 1
    Loop


    '----------------------------------------


    Set headers = ActiveSheet.Range(TimeRng.Address)

    'ActiveWindow.FreezePanes = False
    TimeRng.Activate
    Dim TimeChartRng As Range
    'Get width of header row
    counter = 0
    Do While Not ActiveCell.value = ""
        ActiveCell.Offset(0, 1).Activate
        counter = counter + 1
    Loop
    counter = counter - 1
    TimeRng.Activate

    'go down to first value
    If Not XL2 Is Nothing Then
        TimeRng.Offset(2, 0).Activate
    Else
        TimeRng.Offset(1, 0).Activate
    End If
    'freeze panes
    'ActiveWindow.FreezePanes = True

    ' --------------JR-------------------------
    Dim k As Integer
    k = 0
    Dim bin() As Integer
    ReDim Preserve bin(0)
    bin(0) = 3
    Dim DayOrNight As String
    Dim dayCount As Integer
    dayCount = 1
    Dim whichday() As Integer
    ' ----------------------------------------------

    'this loop creates an array which assigns a number to each new day/night cycle
    Do While Not ActiveCell.value = ""
        ActiveCell.NumberFormat = "hh:mm"
        If TimeValue(ActiveCell.Text) >= TimeValue("07:00") And TimeValue(ActiveCell.Text) < TimeValue("23:00") Then
            'Color index 42 - light blue
            Range(ActiveCell, Cells(ActiveCell.row, ActiveCell.Column + counter)).Interior.Color = RGB(115, 220, 255)

            ' --------------JR-------------------------
            If k = 0 Then
                DayOrNight = "Day"
            End If
            If bin(UBound(bin)) = 2 Then
                dayCount = dayCount + 1
            End If
            ReDim Preserve bin(k)
            bin(k) = 1
            k = k + 1
            ReDim Preserve whichday(ActiveCell.row)
            whichday(ActiveCell.row) = dayCount
            '--------------------------------------------

        Else
            'color index 41 - darker blue
            Range(ActiveCell, Cells(ActiveCell.row, ActiveCell.Column + counter)).Interior.Color = RGB(115, 133, 255)

            ' --------------JR-------------------------
            If k = 0 Then
                DayOrNight = "Night"
            End If
            If bin(UBound(bin)) = 1 Then
                dayCount = dayCount + 1
            End If
            ReDim Preserve bin(k)
            bin(k) = 2
            k = k + 1
            ReDim Preserve whichday(ActiveCell.row)
            whichday(ActiveCell.row) = dayCount
                '------------------------------------------------
        End If

        If TimeChartRng Is Nothing Then
            Set TimeChartRng = ActiveCell
        Else
            Set TimeChartRng = Union(TimeChartRng, ActiveCell)
        End If
        ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Select
    Loop

    'Getting LAeqs ----------------------
    TimeRng.Activate

    'JR----------------------
    Dim LAeqRng() As Variant
    ReDim LAeqRng(dayCount, 63) 'Needs fixing to take variable not 63

    Dim LA90Rng() As Variant
    ReDim LA90Rng(dayCount, 63)

    Dim LAMRng() As Variant
    ReDim LAMRng(dayCount, 31)
    'JR-----------------------

    Dim DayLAeqRng As Range
    Dim NightLAeqRng As Range
    Dim LAeqDay As Double
    Dim LAeqChartRng As Range

    Dim Dayl90minRng As Range
    Dim Nightl90minRng As Range
    Dim l90minCol As Range
    Dim Nightl90minResult As Double
    Dim Dayl90minResult As Double
    Dim LA90ChartRng As Range

    Dim NightLAmaxRng As Range
    Dim LAmaxCol As Range
    Dim NightLAmaxResult As String
    Dim LAmaxChartRng As Range

    'Set LAeqCol
    ActiveCell.Offset(0, counter).Activate
    Set LAeqCol = ActiveSheet.Range("A1:ZZ10000").Find("LAeq", lookat:=xlPart)

    'l90minCol
    If Not XL2 Is Nothing Then
        Set l90minCol = ActiveSheet.Range("A1:ZZ10000").Find("LAF90.0%", lookat:=xlPart)
    Else
        Set l90minCol = ActiveSheet.Range("A1:ZZ10000").Find("LA90", lookat:=xlPart)
    End If

    'LAmax col
    If Not XL2 Is Nothing Then
        Set LAmaxCol = ActiveSheet.Range("A1:ZZ10000").Find("LAFmax", lookat:=xlPart)
    Else
        Set LAmaxCol = ActiveSheet.Range("A1:ZZ10000").Find("LAmax", lookat:=xlPart)
    End If

    Dim coldif As Integer
    If Not l90minCol Is Nothing Then
        coldif = l90minCol.Column - LAeqCol.Column
    End If

    Dim coldif2 As Integer
    If Not LAmaxCol Is Nothing Then
        coldif2 = LAmaxCol.Column - LAeqCol.Column
    End If

    If Not LAeqCol Is Nothing Then
        LAeqCol.Activate
        If Not XL2 Is Nothing Then
            ActiveCell.Offset(2, 0).Activate
        Else
            ActiveCell.Offset(1, 0).Activate
        End If
    End If 'delete if broken

    'JR----------
    Dim z As Integer
    Dim day As Integer
    z = 0
    'JR------------

    Do While Not ActiveCell.value = ""

        'JR------------------
        day = whichday(ActiveCell.row)
        If Not day = dday Then
            z = 0
        End If
        LAeqRng(day, z) = ActiveCell
        If TimeValue(Cells(ActiveCell.row, TimeRng.Column).Text) >= TimeValue("07:00") And TimeValue(Cells(ActiveCell.row, TimeRng.Column).Text) < TimeValue("23:00") Then
            Else
                LAMRng(day, z) = ActiveCell.Offset(0, coldif2)
        End If
        LA90Rng(day, z) = ActiveCell.Offset(0, coldif)
        z = z + 1
        dday = day
        'JR---------------------------------

        'day----------------
        If TimeValue(Cells(ActiveCell.row, TimeRng.Column).Text) >= TimeValue("07:00") And TimeValue(Cells(ActiveCell.row, TimeRng.Column).Text) < TimeValue("23:00") Then
            If DayLAeqRng Is Nothing Then
                Set DayLAeqRng = ActiveCell
            Else
                Set DayLAeqRng = Union(DayLAeqRng, ActiveCell)
            End If

        'night---------------
        Else
            If NightLAeqRng Is Nothing Then
                Set NightLAeqRng = ActiveCell
            Else
              Set NightLAeqRng = Union(NightLAeqRng, ActiveCell)
            End If
        End If

        'generate LAeq chart range
        If LAeqChartRng Is Nothing Then
            Set LAeqChartRng = ActiveCell
        Else
            Set LAeqChartRng = Union(LAeqChartRng, ActiveCell)
        End If
        ActiveCell.Offset(1, 0).Activate
    Loop

    'JR-------------------------------------------------------------
    Dim m As Integer
    Dim n As Integer
    Dim hours() As Double
    ReDim hours(dayCount)
    Dim h As Double
    h = 0#
    L = WorksheetFunction.Max(LA90Rng)

    'Calculate how many measurements in each day (needed to calculate mean)
    For m = 1 To dayCount
        For n = 0 To 63
            If Not LAeqRng(m, n) = "" Then
                h = h + 1#
            End If
        Next n
        hours(m) = h
        h = 0#
    Next m

    'find lowest LA90 in each night
    Dim l90m() As Double
    ReDim l90m(dayCount)

    For m = 1 To dayCount
        For n = 0 To 31
            If LA90Rng(m, n) > 0 And LA90Rng(m, n) < L Then
                L = LA90Rng(m, n)
            End If
        Next n
        l90m(m) = L
        L = WorksheetFunction.Max(LA90Rng)
    Next m

    'find 10th Lmax each night
    Dim LAM() As Double
    ReDim LAM(31)
    Dim LAM2() As Double
    ReDim LAM2(dayCount)
    Dim h2 As Integer


    For m = 1 To dayCount
        For n = 0 To 31
            LAM(n) = LAMRng(m, n)
        Next n
        If hours(m) = 32 Then
            LAM2(m) = WorksheetFunction.Large(LAM, 10)
        ElseIf hours(m) < 3 Then
            LAM2(m) = WorksheetFunction.Max(LAM)
        Else
            h2 = hours(m) * (10# / 32#)
            LAM2(m) = WorksheetFunction.Large(LAM, h2)
        End If

    Next m

    'log -> arithmetic
    For m = 1 To dayCount
        For n = 0 To 63
            LAeqRng(m, n) = 10# ^ ((LAeqRng(m, n)) / 10#)
        Next n
    Next m

    Dim LAeqdays() As Double
    ReDim LAeqdays(1 To dayCount)

    'arithmetic sum
    For m = 1 To dayCount
        For n = 0 To 63
            If Not LAeqRng(m, n) = 1 Then
                LAeqdays(m) = LAeqdays(m) + LAeqRng(m, n)
            End If
        Next n
        LAeqdays(m) = LAeqdays(m) / hours(m)
    Next m

    'arithmetic -> log
    For m = 1 To dayCount
        LAeqdays(m) = 10# * Log10(LAeqdays(m))
    Next m
    'JR----------------------------------------------------



    If Not DayLAeqRng Is Nothing Then
        dayLogAvgResult = LOGAVERAGE(DayLAeqRng)
    End If
    If Not NightLAeqRng Is Nothing Then
        nightLogAvgResult = LOGAVERAGE(NightLAeqRng)
    End If


    'Getting Night lMAx------------

    If Not LAmaxCol Is Nothing Then
        LAmaxCol.Activate
        If Not XL2 Is Nothing Then
            ActiveCell.Offset(2, 0).Activate
        Else
            ActiveCell.Offset(1, 0).Activate
        End If

        If Not LAmaxCol Is Nothing Then
            Do While Not IsEmpty(ActiveCell.value)
                If TimeValue(Cells(ActiveCell.row, TimeRng.Column).Text) >= TimeValue("07:00") And TimeValue(Cells(ActiveCell.row, TimeRng.Column).Text) < TimeValue("23:00") Then
                    Else
                    If NightLAmaxRng Is Nothing Then
                        Set NightLAmaxRng = ActiveCell
                    Else
                        Set NightLAmaxRng = Union(NightLAmaxRng, ActiveCell)
                    End If
                End If

                'generate LAeq chart range
                If LAmaxChartRng Is Nothing Then
                    Set LAmaxChartRng = ActiveCell
                Else
                    Set LAmaxChartRng = Union(LAmaxChartRng, ActiveCell)
                End If
                ActiveCell.Offset(1, 0).Activate
            Loop
            If Not NightLAmaxRng Is Nothing Then
                If WorksheetFunction.count(NightLAmaxRng) < 10 Then
                    largeAmount = WorksheetFunction.count(NightLAmaxRng) / (100 / 32)
                    NightLAmaxResult = WorksheetFunction.Large(NightLAmaxRng, largeAmount)
                Else
                    NightLAmaxResult = WorksheetFunction.Large(NightLAmaxRng, 10)
                End If
            End If
        End If
    End If

    'Getting Night l90min------------
    If Not l90minCol Is Nothing Then
        l90minCol.Activate
        If Not XL2 Is Nothing Then
            ActiveCell.Offset(2, 0).Activate
        Else
            ActiveCell.Offset(1, 0).Activate
        End If

        If Not l90minCol Is Nothing Then
            Do While Not ActiveCell.value = ""
                If TimeValue(Cells(ActiveCell.row, TimeRng.Column).Text) >= TimeValue("07:00") And TimeValue(Cells(ActiveCell.row, TimeRng.Column).Text) < TimeValue("23:00") Then
                        If Dayl90minRng Is Nothing Then
                            Set Dayl90minRng = ActiveCell
                        Else
                            Set Dayl90minRng = Union(Dayl90minRng, ActiveCell)
                        End If
                    Else
                        If Nightl90minRng Is Nothing Then
                            Set Nightl90minRng = ActiveCell
                        Else
                            Set Nightl90minRng = Union(Nightl90minRng, ActiveCell)
                        End If
               End If

                'generate LAeq chart range

                If LA90ChartRng Is Nothing Then
                    Set LA90ChartRng = ActiveCell
                Else
                    Set LA90ChartRng = Union(LA90ChartRng, ActiveCell)
                End If

                ActiveCell.Offset(1, 0).Activate
            Loop
            If Not Nightl90minRng Is Nothing Then
                Nightl90minResult = WorksheetFunction.Min(Nightl90minRng)
                Dayl90minResult = WorksheetFunction.Min(Dayl90minRng)
            End If
        End If
    End If

        'write results------------------


    If Not XL2 Is Nothing Then
        TimeRng.Offset(4, counter + 2).Activate
    Else
        TimeRng.Offset(3, counter + 2).Activate
    End If

    Columns(ActiveCell.Column).AutoFit

    ActiveCell.value = "Date: "
    ActiveCell.Borders(xlEdgeBottom).weight = xlThin
    ActiveCell.Offset(0, 1).Activate

    ActiveCell.value = "LAeq   (Day) "
    ActiveCell.Borders(xlEdgeBottom).weight = xlThin
    ActiveCell.Offset(0, 1).Activate

    ActiveCell.value = "LAeq   (Night) "
    ActiveCell.Borders(xlEdgeBottom).weight = xlThin
    ActiveCell.Offset(0, 1).Activate

    ActiveCell.value = "LA90min   (Day) "
    ActiveCell.Borders(xlEdgeBottom).weight = xlThin
    ActiveCell.Offset(0, 1).Activate

    ActiveCell.value = "LA90min   (Night) "
    ActiveCell.Borders(xlEdgeBottom).weight = xlThin
    ActiveCell.Offset(0, 1).Activate

    ActiveCell.value = "10th LAmax   (Night) "
    ActiveCell.Borders(xlEdgeBottom).weight = xlThin
    ActiveCell.Offset(1, -5).Activate

Dim week2 As Integer

    'JR-------------------
    Dim mdate() As Variant
    ReDim mdate(dayCount)


    For m = 1 To dayCount
        mdate(m) = DateAdd("d", (m - 1), dd)
    Next m


    If DayOrNight = "Day" And dayCount Mod 2 = 0 Then
        GoTo line1
    ElseIf DayOrNight = "Day" And dayCount Mod 2 = 1 Then
        GoTo line2
    ElseIf DayOrNight = "Night" And dayCount Mod 2 = 0 Then
        GoTo line3
    ElseIf DayOrNight = "Night" And dayCount Mod 2 = 1 Then
        GoTo Line4
    Else
        MsgBox "Error 327846"
        Exit Sub
    End If

line1:
    For m = 1 To dayCount / 2
        week2 = (week + (m - 1)) - 1
        If week2 > 7 Then
            week2 = week2 - 7
        End If
        ActiveCell.value = WeekdayName(week2, 2) & ", " & Left(mdate(m), 10)
        ActiveCell.Offset(0, 1).Activate
        'LAeq
        ActiveCell.value = LAeqdays(2 * m - 1)
        ActiveCell.NumberFormat = "0.0"
        ActiveCell.Offset(0, 1).Activate
        ActiveCell.value = LAeqdays(2 * m)
        ActiveCell.NumberFormat = "0.0"
        ActiveCell.Offset(0, 1).Activate
        'LA90
        If Not l90minCol Is Nothing Then
            ActiveCell.value = l90m(2 * m - 1)
        Else
            ActiveCell.value = "no data"
            ActiveCell.HorizontalAlignment = xlRight
        End If
        ActiveCell.Offset(0, 1).Activate
        If Not l90minCol Is Nothing Then
            ActiveCell.value = l90m(2 * m)
        Else
            ActiveCell.value = "no data"
            ActiveCell.HorizontalAlignment = xlRight
        End If
        ActiveCell.Offset(0, 1).Activate
        'LAmax
        If Not LAmaxCol Is Nothing Then
            ActiveCell.value = LAM2(2 * m)
        Else
            ActiveCell.value = "no data"
            ActiveCell.HorizontalAlignment = xlRight
        End If
        ActiveCell.Offset(1, -5).Activate
    Next m
    GoTo lastline

line2:
    For m = 1 To (dayCount + 1) / 2
        week2 = (week + (m - 1)) - 1
        If week2 > 7 Then
            week2 = week2 - 7
        End If
        ActiveCell.value = WeekdayName(week2, 2) & ", " & Left(mdate(m), 10)
        ActiveCell.Offset(0, 1).Activate
        'LAeq
        ActiveCell.value = LAeqdays(2 * m - 1)
        ActiveCell.NumberFormat = "0.0"
        ActiveCell.Offset(0, 1).Activate
        If m = (dayCount + 1) / 2 Then
            ActiveCell.value = "-"
            ActiveCell.HorizontalAlignment = xlRight
        Else
            ActiveCell.value = LAeqdays(2 * m)
        End If
        ActiveCell.NumberFormat = "0.0"

        'LAMin day
        ActiveCell.Offset(0, 1).Activate
        If Not l90minCol Is Nothing Then
            ActiveCell.value = l90m(2 * m - 1)
        Else
            ActiveCell.value = "no data"
            ActiveCell.HorizontalAlignment = xlRight
        End If

        'LAmin night
        ActiveCell.Offset(0, 1).Activate
        If Not l90minCol Is Nothing Then
            If m = (dayCount + 1) / 2 Then
                ActiveCell.value = "-"
                ActiveCell.HorizontalAlignment = xlRight
            Else
                ActiveCell.value = l90m(2 * m)
            End If
        Else
            ActiveCell.value = "no data"
            ActiveCell.HorizontalAlignment = xlRight
        End If

        '10th LAmax
        ActiveCell.Offset(0, 1).Activate
        If Not LAmaxCol Is Nothing Then
            If m = (dayCount + 1) / 2 Then
                ActiveCell.value = "-"
                ActiveCell.HorizontalAlignment = xlRight
            Else
                ActiveCell.value = LAM2(2 * m)
            End If
        Else
            ActiveCell.value = "no data"
            ActiveCell.HorizontalAlignment = xlRight
        End If
        ActiveCell.Offset(1, -5).Activate
    Next m
    GoTo lastline

line3:
    For m = 1 To ((dayCount / 2) + 1)
        week2 = (week + (m - 1)) - 1
        If week2 > 7 Then
            week2 = week2 - 7
        End If
        ActiveCell.value = WeekdayName(week2, 2) & ", " & Left(mdate(m), 10)
        ActiveCell.Offset(0, 1).Activate

        'LAeq
        If m = 1 Then
            ActiveCell.value = "-"
            ActiveCell.HorizontalAlignment = xlRight
        Else
            ActiveCell.value = LAeqdays(2 * m - 2)
        End If
        ActiveCell.NumberFormat = "0.0"
        ActiveCell.Offset(0, 1).Activate
        If m = (dayCount / 2) + 1 Then
            ActiveCell.value = "-"
            ActiveCell.HorizontalAlignment = xlRight
        Else
            ActiveCell.value = LAeqdays(2 * m - 1)
            ActiveCell.NumberFormat = "0.0"
        End If
        ActiveCell.Offset(0, 1).Activate

        'LA90 day
        If Not l90minCol Is Nothing Then
            If m = 1 Then
                ActiveCell.value = "-"
                ActiveCell.HorizontalAlignment = xlRight
            Else
                ActiveCell.value = l90m(2 * m)
            End If
        Else
            ActiveCell.value = "no data"
            ActiveCell.HorizontalAlignment = xlRight
        End If
        ActiveCell.Offset(0, 1).Activate

        'LA90 night
        If Not l90minCol Is Nothing Then
            If m = (dayCount / 2) + 1 Then
                ActiveCell.value = "-"
                ActiveCell.HorizontalAlignment = xlRight
            Else
                ActiveCell.value = l90m((2 * m) - 1)
            End If
        Else
            ActiveCell.value = "no data"
            ActiveCell.HorizontalAlignment = xlRight
        End If
        ActiveCell.Offset(0, 1).Activate

        '10th LAmax
        If Not LAmaxCol Is Nothing Then
            If m = (dayCount / 2) + 1 Then
                ActiveCell.value = "-"
                ActiveCell.HorizontalAlignment = xlRight
            Else
                ActiveCell.value = LAM2((2 * m) - 1)
            End If
        Else
            ActiveCell.value = "no data"
            ActiveCell.HorizontalAlignment = xlRight
        End If
        ActiveCell.Offset(1, -5).Activate
    Next m
    GoTo lastline

Line4:
    For m = 1 To (dayCount + 1) / 2
        week2 = (week + (m - 1)) - 1
        If week2 > 7 Then
            week2 = week2 - 7
        End If
        ActiveCell.value = WeekdayName(week2, 2) & ", " & Left(mdate(m), 10)
        ActiveCell.Offset(0, 1).Activate

        'LAeq
        If m = 1 Then
            ActiveCell.value = "-"
            ActiveCell.HorizontalAlignment = xlRight
        Else
            ActiveCell.value = LAeqdays(2 * m - 2)
        End If
        ActiveCell.NumberFormat = "0.0"
        ActiveCell.Offset(0, 1).Activate
        ActiveCell.value = LAeqdays(2 * m - 1)
        ActiveCell.NumberFormat = "0.0"
        ActiveCell.Offset(0, 1).Activate

        'LA90 day
        If Not l90minCol Is Nothing Then
            If m = 1 Then
                ActiveCell.value = "-"
                ActiveCell.HorizontalAlignment = xlRight
            Else
                ActiveCell.value = l90m(2 * m)
            End If
        Else
            ActiveCell.value = "no data"
            ActiveCell.HorizontalAlignment = xlRight
        End If
        ActiveCell.Offset(0, 1).Activate

        'LA90 night
        If Not l90minCol Is Nothing Then
            ActiveCell.value = l90m((2 * m) - 1)
        Else
            ActiveCell.value = "no data"
            ActiveCell.HorizontalAlignment = xlRight
        End If
        ActiveCell.Offset(0, 1).Activate

        'LAmax
        If Not LAmaxCol Is Nothing Then
            ActiveCell.value = LAM2((2 * m) - 1)
            ActiveCell.Offset(0, 1).Activate
        Else
            ActiveCell.value = "no data"
            ActiveCell.HorizontalAlignment = xlRight
        End If

        ActiveCell.Offset(1, -5).Activate
    Next m
    GoTo lastline

lastline:

    ActiveCell.Offset(1, 0).Activate
    ActiveCell.value = "Entire measurement period:"
    ActiveCell.Offset(0, 1).Activate
    ActiveCell.value = dayLogAvgResult
    ActiveCell.NumberFormat = "0.0"
    ActiveCell.Offset(0, 1).Activate
    ActiveCell.value = nightLogAvgResult
    ActiveCell.NumberFormat = "0.0"
    ActiveCell.Offset(0, 1).Activate
    ActiveCell.value = Dayl90minResult
    ActiveCell.NumberFormat = "0.0"
    ActiveCell.Offset(0, 1).Activate
    ActiveCell.value = Nightl90minResult
    ActiveCell.NumberFormat = "0.0"
     ActiveCell.Offset(0, 1).Activate
    ActiveCell.value = NightLAmaxResult
    ActiveCell.Offset(0, -5).Activate

    Columns(ActiveCell.Column).AutoFit
    ActiveCell.Offset(0, 1).Activate
    Columns(ActiveCell.Column).AutoFit
    ActiveCell.Offset(0, 1).Activate
    Columns(ActiveCell.Column).AutoFit
    ActiveCell.Offset(0, 1).Activate
    Columns(ActiveCell.Column).AutoFit
    ActiveCell.Offset(0, 1).Activate
    Columns(ActiveCell.Column).AutoFit
    ActiveCell.Offset(0, 1).Activate
    Columns(ActiveCell.Column).AutoFit

    'End If

         'Create Chart-------------------------------------------

    Dim rng As Range
    Dim cht As Object

    'Create a chart

    Set cht = ActiveSheet.Shapes.AddChart
    cht.Chart.ChartType = xlLine

    Do While cht.Chart.SeriesCollection.count > 0
        cht.Chart.SeriesCollection(1).Delete
    Loop

    cht.Chart.HasTitle = True
    cht.Chart.ChartTitle.Characters.Text = ""
    cht.Chart.HasTitle = False

    Dim xTitle As String
    Dim yTitle As String

    yTitle = "Sound Pressure Level - dB re 2 x 10-5 Pa"
    xTitle = "Measurement Start Time"

    'X axis name
    cht.Chart.Axes(xlCategory, xlPrimary).HasTitle = True
    cht.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = xTitle
    cht.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Format.TextFrame2.TextRange.Font.Size = 10
    cht.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Format.TextFrame2.TextRange.Font.Bold = False

    'y-axis name
    cht.Chart.Axes(xlValue, xlPrimary).HasTitle = True
    cht.Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = yTitle
    cht.Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters(start:=36, length:=2).Font.Superscript = True
    cht.Chart.Axes(xlValue, xlPrimary).AxisTitle.Format.TextFrame2.TextRange.Font.Size = 10
    cht.Chart.Axes(xlValue, xlPrimary).AxisTitle.Format.TextFrame2.TextRange.Font.Bold = False

    'Give chart some data
    cht.Chart.Parent.Width = 542
    cht.Chart.Parent.Height = 330

    Dim chartposition As Range

    If Not XL2 Is Nothing Then
        TimeRng.Offset(-20, counter + 2).Activate
        cht.Chart.Parent.Left = ActiveCell.Left
        cht.Chart.Parent.Top = ActiveCell.Top

    Else
        TimeRng.Offset(dayCount + 5, counter + 2).Activate
        cht.Chart.Parent.Left = ActiveCell.Left
        cht.Chart.Parent.Top = ActiveCell.Top
    End If

    TimeRng.Activate

    Dim c As Integer
    c = 1

    If Not LAmaxCol Is Nothing Then
        cht.Chart.SeriesCollection.NewSeries
        cht.Chart.SeriesCollection(c).Select
        With Selection
            .Name = "LAmax"
            .Values = LAmaxChartRng
            .XValues = TimeChartRng
            .Format.Line.Visible = msoFalse
            .MarkerSize = 3
            .MarkerStyle = xlMarkerStyleX
            .MarkerBackgroundColorIndex = xlColorIndexNone
            .MarkerForegroundColorIndex = 56
            .Format.Line.weight = 0.25

        End With
        c = c + 1
    End If

        cht.Chart.SeriesCollection.NewSeries
        cht.Chart.SeriesCollection(c).Name = "LAeq"
        cht.Chart.SeriesCollection(c).XValues = TimeChartRng
        cht.Chart.SeriesCollection(c).Values = LAeqChartRng
        cht.Chart.SeriesCollection(c).Border.Color = RGB(31, 73, 125)
        cht.Chart.SeriesCollection(c).MarkerStyle = xlMarkerStyleNone
        cht.Chart.SeriesCollection(c).Format.Line.weight = 1.5
        c = c + 1

    If Not l90minCol Is Nothing Then
        cht.Chart.SeriesCollection.NewSeries
        cht.Chart.SeriesCollection(c).Name = "LA90"
        cht.Chart.SeriesCollection(c).XValues = TimeChartRng
        cht.Chart.SeriesCollection(c).Values = LA90ChartRng
        cht.Chart.SeriesCollection(c).Border.Color = RGB(149, 179, 215)
        cht.Chart.SeriesCollection(c).MarkerStyle = xlMarkerStyleNone
        cht.Chart.SeriesCollection(c).Format.Line.weight = 1.5
        c = c + 1
    End If

    ActiveChart.Axes(xlCategory).MajorTickMark = xlCross
    ActiveChart.Axes(xlValue).MajorTickMark = xlNone


    Dim spacing As Integer
    spacing = CInt(((DataHeight / 96#) / 1.1)) * 4
    ActiveChart.Axes(xlCategory).TickLabelSpacing = spacing
    ActiveChart.Axes(xlCategory).TickLabels.Orientation = xlUpward

    'add vertical gridlines
    ActiveChart.Axes(xlValue).MajorGridlines.Select
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.25
        .Transparency = 0.5
    End With

    ActiveChart.SetElement (msoElementPrimaryCategoryGridLinesMajor)
    ActiveChart.Axes(xlCategory).TickMarkSpacing = spacing
    ActiveChart.Axes(xlCategory).AxisBetweenCategories = False
    ActiveChart.Axes(xlCategory).MajorGridlines.Select
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.25
        .Transparency = 0.5
    End With

    'Dim Name As String
    'Name = ActiveWorkbook.Name
    'ActiveWorkbook.SaveAs Filename:=Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook

    'End If
   startCell.Activate
   Application.ScreenUpdating = True

End Sub
Private Sub TrimFirstandLast()



    Dim add1 As String
    Dim add2 As String
    Dim add3 As String

    Set TimeRng = ActiveSheet.Range("A1:ZZ10000").Find("Time", lookat:=xlPart)
    If TimeRng Is Nothing Then
        MsgBox "'" & searchstring & "' was not found."
        Exit Sub
    End If

    Set XL2 = ActiveSheet.Range("A1:ZZ10000").Find("XL2", lookat:=xlPart)

    'This is a hack
    If Not XL2 Is Nothing Then
        Set TimeRng = ActiveSheet.Range("C23")
    End If

    If Not XL2 Is Nothing Then
        TimeRng.Offset(2, -1).Activate
        add1 = ActiveCell.Address
        ActiveCell.Offset(1, 0).Activate
    Else
        TimeRng.Offset(1, -1).Activate
        add1 = ActiveCell.Address
        ActiveCell.Offset(1, 0).Activate
    End If

    add2 = ActiveCell.Address

    Do While Not ActiveCell = ""
        ActiveCell.Offset(1, 0).Activate
    Loop
    ActiveCell.Offset(-1, 0).Activate

    Do While Not ActiveCell = ""
        ActiveCell.Offset(0, 1).Activate
    Loop
    ActiveCell.Offset(0, -1).Activate

    add3 = ActiveCell.Address

    Range(add2 & ":" & add3).Cut Range(add1)

    If Not XL2 Is Nothing Then
        TimeRng.Offset(2, -1).Activate
    Else
        TimeRng.Offset(1, -1).Activate
    End If

    Do While Not ActiveCell = ""
        ActiveCell.Offset(1, 0).Activate
    Loop
    ActiveCell.Offset(-1, 0).Activate

    add1 = ActiveCell.Address

    Do While Not ActiveCell = ""
        ActiveCell.Offset(0, 1).Activate
    Loop
    ActiveCell.Offset(0, -1).Activate

    add2 = ActiveCell.Address

    Range(add1 & ":" & add2).Clear

End Sub