Script for reporting

Ganastia · Nov 9, 2023

I have been placed in charge of reporting in my small company and my excel experience is semi-limited and would love is someone can assist me with this issue. We have Daily/Weekly reports that when it has been turned over seem very inefficient and I'm trying to streamline it.

Our reports are pulled from our system below and we manually sort the whole sheet using the information in column A. We then add 2 rows underneath each unique value based on Column A, we then add a COUNTA function to count how many times that unique value was used in bold under Column C and a SUM under Column K. There is also a final total based on those COUNTA and SUM Formulas on the very bottom. I'll include 2 mini sheets, the first with an example of how data is pulled vs how the final table looks. I have attempted to use AI to write this for me but it can't get the script right so I figured I'd come to the experts if you would be so kind as to assist with this.

Initial Pull

Example v2.xlsx

A

B

C

D

E

F

G

H

I

J

K

1

Name

Number

Info

Data2

Data3

Data4

Data5

Data6

Data7

Data8

Amount

2

Dan

1

a

123456

3

Bob

10

b

234567

4

Sally

9

c

345678

5

Sue

8

b

456789

6

Dan

5

a

134679

7

Bob

3

d

258258

8

Sally

6

e

978542

9

Sue

2

a

654321

10

Dan

4

c

623875

11

Bob

7

g

123669

Sheet1

Final Product

Example v2.xlsx

A

B

C

D

E

F

G

H

I

J

K

1

Name

Number

Info

Data2

Data3

Data4

Data5

Data6

Data7

Data8

Amount

2

Bob

10

b

$234,567.00

3

Bob

3

d

$258,258.00

4

Bob

7

g

$123,669.00

5

3

$616,494.00

6

7

Dan

1

a

$123,456.00

8

Dan

5

a

$134,679.00

9

Dan

4

c

$623,875.00

10

3

$882,010.00

11

12

Sally

9

c

$345,678.00

13

Sally

6

e

$978,542.00

14

2

$1,324,220.00

15

16

Sue

8

b

$456,789.00

17

Sue

2

a

$654,321.00

18

2

$1,111,110.00

19

20

10

$3,933,834.00

Sheet1

Cell Formulas
Range	Formula
C5,C10	C5	=COUNTA(C2:C4)
K5,K10	K5	=SUM(K2:K4)
C14,C18	C14	=COUNTA(C12:C13)
K14,K18	K14	=SUM(K12:K13)
C20,K20	C20	=SUM(C18,C14,C10,C5)

Ganastia · Nov 9, 2023

Ganastia said:
I have been placed in charge of reporting in my small company and my excel experience is semi-limited and would love is someone can assist me with this issue. We have Daily/Weekly reports that when it has been turned over seem very inefficient and I'm trying to streamline it.

Our reports are pulled from our system below and we manually sort the whole sheet using the information in column A. We then add 2 rows underneath each unique value based on Column A, we then add a COUNTA function to count how many times that unique value was used in bold under Column C and a SUM under Column K. There is also a final total based on those COUNTA and SUM Formulas on the very bottom. I'll include 2 mini sheets, the first with an example of how data is pulled vs how the final table looks. I have attempted to use AI to write this for me but it can't get the script right so I figured I'd come to the experts if you would be so kind as to assist with this.

Initial Pull

Example v2.xlsx
A B C D E F G H I J K
1 Name Number Info Data2 Data3 Data4 Data5 Data6 Data7 Data8 Amount
2 Dan 1 a a a a a a a a 123456
3 Bob 10 b b b b b b b b 234567
4 Sally 9 c c c c c c c c 345678
5 Sue 8 b b b b b b b b 456789
6 Dan 5 a a a a a a a a 134679
7 Bob 3 d d d d d d d d 258258
8 Sally 6 e e e e e e e e 978542
9 Sue 2 a a a a a a a a 654321
10 Dan 4 c c c c c c c c 623875
11 Bob 7 g g g g g g g g 123669
Sheet1

Final Product

Example v2.xlsx
A B C D E F G H I J K
1 Name Number Info Data2 Data3 Data4 Data5 Data6 Data7 Data8 Amount
2 Bob 10 b b b b b b b b $234,567.00
3 Bob 3 d d d d d d d d $258,258.00
4 Bob 7 g g g g g g g g $123,669.00
5 3 $616,494.00
6
7 Dan 1 a a a a a a a a $123,456.00
8 Dan 5 a a a a a a a a $134,679.00
9 Dan 4 c c c c c c c c $623,875.00
10 3 $882,010.00
11
12 Sally 9 c c c c c c c c $345,678.00
13 Sally 6 e e e e e e e e $978,542.00
14 2 $1,324,220.00
15
16 Sue 8 b b b b b b b b $456,789.00
17 Sue 2 a a a a a a a a $654,321.00
18 2 $1,111,110.00
19
20 10 $3,933,834.00
Sheet1
Cell Formulas
Range Formula
C5,C10 C5 =COUNTA(C2:C4)
K5,K10 K5 =SUM(K2:K4)
C14,C18 C14 =COUNTA(C12:C13)
K14,K18 K14 =SUM(K12:K13)
C20,K20 C20 =SUM(C18,C14,C10,C5)

I just realized I didn't include that the sheet on each pull is named "Data"

HighAndWilder · Nov 10, 2023

Welcome to MrExcel

I couldn't sleep so I put this together for you.

It contains some generic code so if you have other similar reports that need creating just let me know and it can be adapted for those.

It assumes that the sheet that contains your data is named 'Data'.
If this is different then change this line of code.
strOriginalDataSheet = "Data"

It also puts the report into a sheet named 'Report'
If this is to be different then change this line of code.
strReportSheet = "Report"

It creates a temporary sheet to avoid changing the source data sheet.
This temporary worksheet is named 'Temp'
If you have another sheet with the same name then change this line of code.
strTempSheet = "Temp"
It deletes this sheet after the report has been created.

Test this in a workbook that just contains your source data worksheet.

The procedure 'subReporting' is the one that you run.

There is no need to sort the data first as the code does it for you.

VBA Code:

Public Sub subReporting()
Dim WsTemp As Worksheet
Dim WsReport As Worksheet
Dim rngData As Range
Dim arrUnique() As Variant
Dim i As Integer
Dim intRow As Integer
Dim intRows As Integer
Dim strOriginalDataSheet As String
Dim strTempSheet As String
Dim strReportSheet As String

  ActiveWorkbook.Save
  
  strOriginalDataSheet = "Data"
  
  strTempSheet = "Temp"
  
  strReportSheet = "Report"
  
  ' Copy original data to temporary worksheet for subtotals.
  ' The original data worksheet is not altered.
  Call subCopySourceData(strOriginalDataSheet, strTempSheet)

  ' Set source data worksheet object
  Set WsTemp = Worksheets(strTempSheet)
  
  Set rngData = WsTemp.Range("A1").CurrentRegion
  
  ' Get the number of rows of data.
  intRows = rngData.Rows.Count - 1
  
  ' Get unique list of values to group on.
  arrUnique = Evaluate("SORT(UNIQUE(" & rngData.Range("A1").Resize(intRows, 1).Offset(1, 0).Address & ",FALSE,FALSE))")
  
  ' Sort the data by column one.
  With WsTemp
    .Sort.SortFields.Clear
    .Sort.SortFields.Add2 Key:=rngData.Columns("A").Resize(rngData.Columns("A").Rows.Count - 1, 1), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
        .SetRange rngData
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
  End With
  
  ' Group and create sub totals.
  rngData.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(11), _
      Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    
  Set WsReport = fncCreateWorksheet(strReportSheet)
    
  ' Copy the data from the subtotals sheet.
  WsTemp.Range("A1").CurrentRegion.Copy WsReport.Range("A1")
  
  Call subDeleteWorksheet(WsTemp)
  
  ' Format the report worksheet.
  Call subFormatReport(WsReport)
    
  With WsReport.Range("A1").CurrentRegion
  
    ' Insert row count per group.
    For i = LBound(arrUnique) To UBound(arrUnique)
      intRow = WorksheetFunction.Match(arrUnique(i, 1) & " Total", .Columns(1), 0)
      .Cells(intRow, "A").Value = ""
      .Rows(intRow + 1).EntireRow.Insert
      .Rows(intRow).Font.Bold = True
      .Cells(intRow, 3).Value = WorksheetFunction.CountIf(.Columns(1), arrUnique(i, 1))
    Next i
    
    ' Remove 'Grand Total'
    .Cells(.Rows.Count, 1).Value = ""
    
    ' Insert total number of rows of data and bold last row.
    With .Rows(.Rows.Count)
      .Cells(3) = intRows
      .Font.Bold = True
    End With
    
    ' Set last column to currency.
    .Columns(.Columns.Count).NumberFormat = "£#,##0.00"
  
  End With
    
  ActiveWorkbook.Save
  
End Sub

Private Sub subFormatReport(WsReport As Worksheet)

  With WsReport.UsedRange
    .Font.Name = "Arial"
    .Font.Size = 14
    .Cells.EntireColumn.AutoFit
    .Cells.RowHeight = 25
  End With

End Sub

Private Sub subCopySourceData(strSourceWorksheet, strDestinationWorksheet)

  Application.DisplayAlerts = False
  On Error Resume Next
  Worksheets(strDestinationWorksheet).Delete
  On Error GoTo 0
  Application.DisplayAlerts = True
  
  Worksheets(strSourceWorksheet).Copy after:=Sheets(Sheets.Count)
  
  ActiveSheet.Name = strDestinationWorksheet
  
End Sub

Public Sub subDeleteWorksheet(Ws As Worksheet)

  Application.DisplayAlerts = False
  On Error Resume Next
  Ws.Delete
  On Error GoTo 0
  Application.DisplayAlerts = True
  
End Sub

Public Function fncCreateWorksheet(strWorksheet As String) As Worksheet
Dim strActive As String

  strActive = ActiveSheet.Name
  
  Application.DisplayAlerts = False
  On Error Resume Next
  Worksheets(strWorksheet).Delete
  On Error GoTo 0
  Application.DisplayAlerts = True
  
  Worksheets.Add after:=Sheets(Sheets.Count)

  ActiveSheet.Name = strWorksheet
  
  Set fncCreateWorksheet = ActiveSheet

  Worksheets(strActive).Activate
  
End Function

Ganastia · Nov 10, 2023

HighAndWilder said:

Welcome to MrExcel

I couldn't sleep so I put this together for you.

It contains some generic code so if you have other similar reports that need creating just let me know and it can be adapted for those.

It assumes that the sheet that contains your data is named 'Data'.
If this is different then change this line of code.
strOriginalDataSheet = "Data"

It also puts the report into a sheet named 'Report'
If this is to be different then change this line of code.
strReportSheet = "Report"

It creates a temporary sheet to avoid changing the source data sheet.
This temporary worksheet is named 'Temp'
If you have another sheet with the same name then change this line of code.
strTempSheet = "Temp"
It deletes this sheet after the report has been created.

Test this in a workbook that just contains your source data worksheet.

The procedure 'subReporting' is the one that you run.

There is no need to sort the data first as the code does it for you.

VBA Code:

Public Sub subReporting()
Dim WsTemp As Worksheet
Dim WsReport As Worksheet
Dim rngData As Range
Dim arrUnique() As Variant
Dim i As Integer
Dim intRow As Integer
Dim intRows As Integer
Dim strOriginalDataSheet As String
Dim strTempSheet As String
Dim strReportSheet As String

  ActiveWorkbook.Save
 
  strOriginalDataSheet = "Data"
 
  strTempSheet = "Temp"
 
  strReportSheet = "Report"
 
  ' Copy original data to temporary worksheet for subtotals.
  ' The original data worksheet is not altered.
  Call subCopySourceData(strOriginalDataSheet, strTempSheet)

  ' Set source data worksheet object
  Set WsTemp = Worksheets(strTempSheet)
 
  Set rngData = WsTemp.Range("A1").CurrentRegion
 
  ' Get the number of rows of data.
  intRows = rngData.Rows.Count - 1
 
  ' Get unique list of values to group on.
  arrUnique = Evaluate("SORT(UNIQUE(" & rngData.Range("A1").Resize(intRows, 1).Offset(1, 0).Address & ",FALSE,FALSE))")
 
  ' Sort the data by column one.
  With WsTemp
    .Sort.SortFields.Clear
    .Sort.SortFields.Add2 Key:=rngData.Columns("A").Resize(rngData.Columns("A").Rows.Count - 1, 1), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
        .SetRange rngData
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
  End With
 
  ' Group and create sub totals.
  rngData.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(11), _
      Replace:=True, PageBreaks:=False, SummaryBelowData:=True
   
  Set WsReport = fncCreateWorksheet(strReportSheet)
   
  ' Copy the data from the subtotals sheet.
  WsTemp.Range("A1").CurrentRegion.Copy WsReport.Range("A1")
 
  Call subDeleteWorksheet(WsTemp)
 
  ' Format the report worksheet.
  Call subFormatReport(WsReport)
   
  With WsReport.Range("A1").CurrentRegion
 
    ' Insert row count per group.
    For i = LBound(arrUnique) To UBound(arrUnique)
      intRow = WorksheetFunction.Match(arrUnique(i, 1) & " Total", .Columns(1), 0)
      .Cells(intRow, "A").Value = ""
      .Rows(intRow + 1).EntireRow.Insert
      .Rows(intRow).Font.Bold = True
      .Cells(intRow, 3).Value = WorksheetFunction.CountIf(.Columns(1), arrUnique(i, 1))
    Next i
   
    ' Remove 'Grand Total'
    .Cells(.Rows.Count, 1).Value = ""
   
    ' Insert total number of rows of data and bold last row.
    With .Rows(.Rows.Count)
      .Cells(3) = intRows
      .Font.Bold = True
    End With
   
    ' Set last column to currency.
    .Columns(.Columns.Count).NumberFormat = "£#,##0.00"
 
  End With
   
  ActiveWorkbook.Save
 
End Sub

Private Sub subFormatReport(WsReport As Worksheet)

  With WsReport.UsedRange
    .Font.Name = "Arial"
    .Font.Size = 14
    .Cells.EntireColumn.AutoFit
    .Cells.RowHeight = 25
  End With

End Sub

Private Sub subCopySourceData(strSourceWorksheet, strDestinationWorksheet)

  Application.DisplayAlerts = False
  On Error Resume Next
  Worksheets(strDestinationWorksheet).Delete
  On Error GoTo 0
  Application.DisplayAlerts = True
 
  Worksheets(strSourceWorksheet).Copy after:=Sheets(Sheets.Count)
 
  ActiveSheet.Name = strDestinationWorksheet
 
End Sub

Public Sub subDeleteWorksheet(Ws As Worksheet)

  Application.DisplayAlerts = False
  On Error Resume Next
  Ws.Delete
  On Error GoTo 0
  Application.DisplayAlerts = True
 
End Sub

Public Function fncCreateWorksheet(strWorksheet As String) As Worksheet
Dim strActive As String

  strActive = ActiveSheet.Name
 
  Application.DisplayAlerts = False
  On Error Resume Next
  Worksheets(strWorksheet).Delete
  On Error GoTo 0
  Application.DisplayAlerts = True
 
  Worksheets.Add after:=Sheets(Sheets.Count)

  ActiveSheet.Name = strWorksheet
 
  Set fncCreateWorksheet = ActiveSheet

  Worksheets(strActive).Activate
 
End Function

You are a lifesaver!!!

The good news is I have convinced the upper management to standardize all daily/weekly reporting to appear in the same format so this should work for all!

I did have to alter the code a bit as the source data actually goes until column Y but I made the mini-sheet example so small as those are the only columns that have an item placed underneath them. I altered the code to no longer change the last column to currency which was an easy fix (Thank you for describing every function - that was very helpful). I also removed the lines that formatted the new sheet as I am trying to keep the source formatting as it allows all columns to be on one legal sheet of paper and not require a magnifying glass.

I cannot say enough thank you's for your help on this you just saved me hours of adding lines to reports every day! I definitely owe you a beer!

HighAndWilder · Nov 10, 2023

Ganastia said:
You are a lifesaver!!!

The good news is I have convinced the upper management to standardize all daily/weekly reporting to appear in the same format so this should work for all!

I did have to alter the code a bit as the source data actually goes until column Y but I made the mini-sheet example so small as those are the only columns that have an item placed underneath them. I altered the code to no longer change the last column to currency which was an easy fix (Thank you for describing every function - that was very helpful). I also removed the lines that formatted the new sheet as I am trying to keep the source formatting as it allows all columns to be on one legal sheet of paper and not require a magnifying glass.

I cannot say enough thank you's for your help on this you just saved me hours of adding lines to reports every day! I definitely owe you a beer!

I'm glad that it helped.

All reports need to be standardized in terms of look and automated as far as possible. BUT along with this goes a standard
way of coding, well documented code and workbook and worksheet naming conventions.

If you need any help in automating other reports then just submit another post and message me with the link.

I don't drink beer but I do eat lots of cake.

Script for reporting

Ganastia

New Member

Excel Facts

Ganastia

New Member

HighAndWilder

Active Member

Ganastia

New Member

HighAndWilder

Active Member

Similar threads

Forum statistics

Share this page

Script for reporting

Ganastia

New Member

Excel Facts

Ganastia

New Member

HighAndWilder

Active Member

Ganastia

New Member

HighAndWilder

Active Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock