Subscript Out of Range

[Billy Hill]

I'm getting a Subscript Out of Range error running this code. The error is on the line above the error window. When it gets to the Set wsSource line it pops up that error. Full code is below. Does anyone know what is causing this? I checked with IT, there is no security in place that might cause this. Is it some dumb typo I missed?

TYIA!

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("DAILY PRODUCTION REPORT")

'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

 

[Joe4]

That usually means that it cannot find a Sheet named "DAILY PRODUCTION REPORT".
Are you sure you are in the correct workbook when this runs?
Are you sure that is the EXACT same of the sheet? Something as simple as an extra space at the beginning, in the middle, or at the end would cause it not to find it.

 

[Anthony47]

"ThisWorkbook" means "the workbook where the macro is stored"; in your case I seem the macro is stored in Personal.xlsb, so I think you should use Workbooks("SHOP PRODUCTION etc etc").Sheets("DAILY PRODUCTION REPORT")

 

[Fluff]

Duplicate to: Production Report to Itemize Each Part Number with Summary

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread.