Trying to Create a Summary Report

Hi Mcrawiva

This Code is in the attached (if indeed I can add the Attachment) and appears to do as you require, including this

"In each worksheet I have added a column (AA) where the data for the day is totalled (I do this manually too and would like to be able to automate it"

Option Explicit

Sub Create_Summary()
    Dim ws As Worksheet, ws1 As Worksheet
    Dim NR As Long, LR As Long, i As Long, j As Long
    Dim myArray As Variant
    Dim c As Range, cel As Range

    myArray = Array("NUCLEAR Total", "COAL Total", "GAS Total", "HYDRO Total", "WIND Total", "OTHER Total")

    Set ws = Sheets("Summary")
    
    Application.ScreenUpdating = False
    With ws
        NR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row + 1
        .Rows(4).Resize(NR - 1, 1).EntireRow.ClearContents
        NR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row + 1
    End With
    j = 2
    For Each ws1 In ThisWorkbook.Sheets
        If ws1.Name <> "Summary" Then
            With ws1
                .Range("AA5").Value = "Total Energy Output for 24 hrs"
                LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious).Row
                For Each cel In .Range("AA6:AA" & LR)
                    cel.FormulaR1C1 = "=SUM(RC[-24]:RC[-1])"
                Next cel
            End With
            ws.Range("A" & NR).Value = ws1.Name
            With ws1.Columns(1)
                For i = LBound(myArray) To UBound(myArray)
                    Set c = .Find(myArray(i), LookIn:=xlValues)
                    ws.Cells(NR, j).Value = c.Offset(1, 26).Value
                    j = j + 1
                Next i
            End With
            ws.Cells(NR, j - 1).Offset(0, 1).FormulaR1C1 = "=SUM(RC[-6]:RC[-1])"
            j = 2
            NR = NR + 1
        End If
    Next ws1
    Application.ScreenUpdating = True
End Sub

I've not figured how to add Quotes nor Code Tags with the "New Look"...hopefully this will make sense.

Hi Mcrawiva

If the Code works for you in your Sample File and does NOT work in the New Data Set, I'd suggest there's something different in the New Data Set.

Please post the New Data Set (with Code) and I'll see if I can Debug it for you.

Hi Mcrawiva

The issue is that your Summary Sheet has no Headers; I,ll modify the Code to insert them.

Hi Mcrawiva

This Code has been modified to add Headers to Summary if they don't exist.

Mods and Admins...please excuse the absence of Code Tags...my current Interface lacks that Option

Option Explicit

Sub Create_Summary()
    Dim ws As Worksheet, ws1 As Worksheet
    Dim NR As Long, LR As Long, i As Long, j As Long
    Dim myArray As Variant, Headers As Variant
    Dim c As Range, cel As Range

    myArray = Array("NUCLEAR Total", "COAL Total", "GAS Total", "HYDRO Total", "WIND Total", "OTHER Total")
    Headers = Array("Date", "Nuclear", "Coal", "Gas", "Hydro", "Wind", "Other", "Total Energy Output for 24 hrs")

    Set ws = Sheets("Summary")

    Application.ScreenUpdating = False
    With ws
        .Cells.Clear
        .Range("A3").Resize(1, UBound(Headers) + 1) = Headers
        NR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row + 1
    End With
    j = 2
    For Each ws1 In ThisWorkbook.Sheets
        If ws1.Name <> "Summary" And Not ws1.Name = "Sheet1" Then
            With ws1
'                .Range("AA5").Value = "Total Energy Output for 24 hrs"
                LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious).Row
                .Range("H4").FormulaR1C1 = "=SUM(RC[-24]:RC[-1])"
                .Range("H4").AutoFill Destination:=.Range("H4:H" & LR), Type:=xlFillDefault

                '                For Each cel In .Range("AA6:AA" & LR)
                '                    cel.FormulaR1C1 = "=SUM(RC[-24]:RC[-1])"
                '                Next cel
            End With
            ws.Range("A" & NR).Value = ws1.Name
            With ws1.Columns(1)
                For i = LBound(myArray) To UBound(myArray)
                    Set c = .Find(myArray(i), LookIn:=xlValues)
                    ws.Cells(NR, j).Value = c.Offset(1, 26).Value
                    j = j + 1
                Next i
            End With
            ws.Cells(NR, j - 1).Offset(0, 1).FormulaR1C1 = "=SUM(RC[-6]:RC[-1])"
            j = 2
            NR = NR + 1
        End If
    Next ws1
    Application.ScreenUpdating = True
End Sub