Production Report to Itemize Each Part Number with Summary

[Billy Hill]

I have a production report that has the goals and total units made for 3 shifts. I summarize each part number for easy reading with the totals. The results can be an image or data.

My source data looks like this:

And I want the results to look like this with all the part numbers, (an image of the summaries is fine, I will be emailing it to the owner for review)

Is there a way to automate this in VBA?

TYIA!

~B

 

[GSP75]

Yes, it is possible to automate this using VBA. Here is an example code that can create a summary table for each part number and copy it as an image to a new sheet:

Sub CreateSummaryTable()
Dim wsSource As Worksheet
Dim wsSummary As Worksheet
Dim partNumber As String
Dim lastRow As Long
Dim rngPartData As Range
Dim rngSummary As Range
Dim chartObj As ChartObject

'Set the source worksheet
Set wsSource = ThisWorkbook.Sheets("Source")

'Create a new worksheet for the summary tables
Set wsSummary = ThisWorkbook.Sheets.Add(After:=wsSource)
wsSummary.Name = "Summary"

'Loop through each part number in the source data
lastRow = wsSource.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
partNumber = wsSource.Cells(i, "A").Value

'Find the range of data for the current part number
Set rngPartData = wsSource.Range("A" & i & ":D" & i)
Do Until wsSource.Cells(i + 1, "A").Value <> partNumber Or i >= lastRow
Set rngPartData = Union(rngPartData, wsSource.Range("A" & i + 1 & ":D" & i + 1))
i = i + 1
Loop

'Create a summary table for the current part number
Set rngSummary = wsSummary.Cells((wsSummary.Cells(Rows.Count, "A").End(xlUp).Row + 2), 1)
rngPartData.Copy
rngSummary.PasteSpecial xlPasteValues
rngSummary.PasteSpecial xlPasteFormats
Set chartObj = wsSummary.Shapes.AddChart2(227, xlColumnClustered).Chart.Parent
chartObj.Chart.SetSourceData Source:=rngSummary.Offset(0, 2).Resize(1, 2), PlotBy:=xlRows
chartObj.Chart.ChartArea.Format.Line.Visible = msoFalse
chartObj.Top = rngSummary.Top
chartObj.Left = rngSummary.Left + rngSummary.Width + 10
chartObj.Height = rngSummary.Height

'Format the summary table
rngSummary.Offset(-1, 0).Value = partNumber
rngSummary.Offset(-1, 1).Value = "Total"
rngSummary.Offset(0, 2).Value = "Shift 1"
rngSummary.Offset(0, 3).Value = "Shift 2"
rngSummary.Resize(rngPartData.Rows.Count + 1, rngPartData.Columns.Count).Borders.LineStyle = xlContinuous

'Calculate the totals for each shift
For j = 3 To 4
rngSummary.Cells(rngPartData.Rows.Count + 1, j).Formula = "=SUM(" & rngSummary.Cells(1, j).Address & ":" & rngSummary.Cells(rngPartData.Rows.Count, j).Address & ")"
rngSummary.Cells(rngPartData.Rows.Count + 1, j).NumberFormat = "0"
Next j
Next i

'Delete the original data from the summary sheet
wsSummary.Cells.ClearFormats
wsSummary.Cells.ClearContents
End Sub

Note: This code assumes that your source data is in a worksheet named "Source". If your source data is in a different worksheet, you will need to change the worksheet name in the code.

This code creates a new worksheet named "Summary" and creates a summary table for each part number in your source data.

 

[Billy Hill]

Thanks for the quick reply.

I tried your code, and changed the name of my Sheet to Source but I get a Subscript out of range error on the "Set wsSource =" line.

I tried a few things including changing the worksheet name in the code. Still getting the error. I checked all the spelling and didn't see anything that stands out.

Also tried closing and re-opening the worksheet hoping it wasn't registering the sheet's name change but still no luck.

Any idea?

 

[GSP75]

keyboard shortcuts or the Name Box. If you want to completely restrict access to locked cells, you can use the Protect method with the UserInterfaceOnly parameter set to True, as described in my previous answer.

 

[Fluff]

How does that answer the problem of the "Subscript out of range error"?

 

[GSP75]

I apologize for the confusion. The error message "Subscript out of range" typically means that the code is trying to refer to an object or element that doesn't exist, such as a worksheet or a cell outside of the defined range.

 

[Billy Hill]

I apologize for the confusion. The error message "Subscript out of range" typically means that the code is trying to refer to an object or element that doesn't exist, such as a worksheet or a cell outside of the defined range.

I've tried changing the names of the variables. Also reviewed the code for typos.

Could this be a security issue?

 

[GSP75]

It's possible that the error is caused by a security issue. Excel's security settings may prevent macros from accessing certain worksheets or workbooks. You can check your security settings by going to the "Developer" tab, clicking "Macro Security" in the "Code

 

[Billy Hill]

I checked with IT. There are no security policies in place that would prevent this from working.

When I try to use Set wsSource = ThisWorkbook.Sheets.Add(After:=wsSource) I get a Subscript Out of Range 9 error. What else might cause this? I've quadruple-checked the syntax and copy/pasted the sheet name to eliminate any typos.

Sub CreateSummaryTable()
Dim wsSource As Worksheet
Dim wsSummary As Worksheet
Dim partNumber As String
Dim lastRow As Long
Dim rngPartData As Range
Dim rngSummary As Range
Dim chartObj As ChartObject

'Set the source worksheet
Set wsSource = ThisWorkbook.Sheets("Source")

'Create a new worksheet for the summary tables
Set wsSummary = ThisWorkbook.Sheets.Add(After:=wsSource)
wsSummary.Name = "Summary"

 

[Joe4]

As Anthony47 pointed out over here: Subscript Out of Range, the issue is that you appear to have this code saved in your Personal Macro Workbook.

If you changed "ThisWorkbook" to "ActiveWorkbook", I think it will work for you.