Macro Summary Creation

[smn]

Hi,

I am trying to develop a macro that will help me summarize information across several sheets in a workbook over a certain (changeable) date range for a number of unique fields.


So the summary sheet will look something like the below. The user will be able to input two dates and then run the macro to see the sum of values across the workbook for those dates for each of the letters A, B, C, D, etc.

The data sheets are identical apart from their names and will look like the below (named "S1"). There will be the weeks as headers (x1, x2, x3, x4, x5, etc.). The unique fields (A, B, C, D) are columns. Each unique field is not present in every sheet (i.e., this one only has B and F).

If I had a second worksheet (named "S2") as below, then ideally the after running would display the following result:

Would this type of macro be possible? And if so, how could it be accomplished? Any help is greatly appreciated!

 

[Legacy 143009]

Yes, it is possible. What are the real names of the sheets? I will look if a pattern is possible to loop through them. Otherwise, the sheetnames should be hardcoded into a names array.

Also I will need the weeks row number on each, items column letter on each sheet, dates rows and columns on results sheet.

 

[smn]

Yes, it is possible. What are the real names of the sheets? I will look if a pattern is possible to loop through them. Otherwise, the sheetnames should be hardcoded into a names array.

Also I will need the weeks row number on each, items column letter on each sheet, dates rows and columns on results sheet.

Hi, there will be many sheet names whose names are listed on a separate sheet (from A7-A40). The sheet names are not related to each other, so there will not be a discernable pattern.

The weeks row number will be always be '4'. The items column letter on each sheet will always be 'B.' On the results sheet, the Date1 will be B2 and Date2 will be B3.

 

[Dave Patton]

You could use Vstack to consolidate the ranges or tables of information and then use formulas to calculate information.
One example on the forum is
www.mrexcel.com/board/threads/consolidating-multiple-tables-from-separate-sheets.1233707/

 

[Legacy 143009]

One more question,

Do letters appear more than once on the same column?

 

[smn]

One more question,

Do letters appear more than once on the same column?

No they do not

 

[Legacy 143009]

This should work I am also sharing the sample file

Sub test()
  Dim results As Worksheet, wsNames As Variant
  Set results = Worksheets("Results")
  wsNames = Split("S1,S2", ",")
  results.Range("B7:B" & results.Cells(Rows.Count, "A").End(xlUp).Row) = 0
  For i = 7 To results.Cells(Rows.Count, "A").End(xlUp).Row
    For Each ws In wsNames
      With Worksheets(ws)
        For r = 5 To .Cells(Rows.Count, "B").End(xlUp).Row
          If .Cells(r, "B").Value2 = results.Cells(i, "A").Value2 Then
            For c = 3 To .Cells(4, Columns.Count).End(xlToLeft).Column
              If .Cells(4, c).Value2 >= results.Range("B2").Value2 And .Cells(4, c).Value2 <= results.Range("B3").Value2 Then
                results.Cells(i, "B").Value2 = results.Cells(i, "B").Value2 + .Cells(r, c).Value2
              End If
            Next
            GoTo nextWS 'Delete this line if a letter appears more than once in a column
          End If
        Next
      End With
nextWS: 'Delete this line if a letter appears more than once in a column
    Next
  Next
End Sub

WeTransfer - Send Large Files & Share Photos Online - Up to 2GB Free

WeTransfer is the simplest way to send your files around the world

we.tl

 

[smn]

This should work I am also sharing the sample file

Sub test()
  Dim results As Worksheet, wsNames As Variant
  Set results = Worksheets("Results")
  wsNames = Split("S1,S2", ",")
  results.Range("B7:B" & results.Cells(Rows.Count, "A").End(xlUp).Row) = 0
  For i = 7 To results.Cells(Rows.Count, "A").End(xlUp).Row
    For Each ws In wsNames
      With Worksheets(ws)
        For r = 5 To .Cells(Rows.Count, "B").End(xlUp).Row
          If .Cells(r, "B").Value2 = results.Cells(i, "A").Value2 Then
            For c = 3 To .Cells(4, Columns.Count).End(xlToLeft).Column
              If .Cells(4, c).Value2 >= results.Range("B2").Value2 And .Cells(4, c).Value2 <= results.Range("B3").Value2 Then
                results.Cells(i, "B").Value2 = results.Cells(i, "B").Value2 + .Cells(r, c).Value2
              End If
            Next
            GoTo nextWS 'Delete this line if a letter appears more than once in a column
          End If
        Next
      End With
nextWS: 'Delete this line if a letter appears more than once in a column
    Next
  Next
End Sub

WeTransfer - Send Large Files & Share Photos Online - Up to 2GB Free

WeTransfer is the simplest way to send your files around the world

we.tl

This worked great - thank you!

 

[Legacy 143009]

Glad it did work! Thanks for the feedback