Private Sub CommandButton1_Click()
Dim WC$
Dim LR As Long, i As Long
Dim strName As String
Application.ScreenUpdating = False
Workcenter = ListBox1.Value
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Zeroes " & Workcenter
Range("A1").FormulaR1C1 = "Material"
Range("B1").FormulaR1C1 = "Setup"
Range("C1").FormulaR1C1 = "Run"
Range("D1").FormulaR1C1 = "Amort"
Range("N4").FormulaR1C1 = "Average Setup"
Range("N5").FormulaR1C1 = "Average Run"
Range("N6").FormulaR1C1 = "Average Amort"
Sheets("Routings DJL").Activate
With ActiveSheet
LR = .Range("E" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If .Range("E" & i).Value = Workcenter Then
.Range("A" & i).Copy
Sheets("Zeroes " & Workcenter).Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
.Range("F" & i).Copy
Sheets("Zeroes " & Workcenter).Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
.Range("G" & i).Copy
Sheets("Zeroes " & Workcenter).Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
.Range("H" & i).Copy
Sheets("Zeroes " & Workcenter).Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
Next i
End With
Sheets("Zeroes " & Workcenter).Select
Dim wksConstraints As Worksheet
Dim rtChart As Chart
Dim LastRow As Long
Dim rngOne As Range, rngTwo As Range
Set wksConstraints = Sheets("Zeroes " & Workcenter)
LastRow = wksConstraints.Cells(wksConstraints.Rows.Count, "A").End(xlUp).Row
Set rngOne = wksConstraints.Range("A2:A" & LastRow)
Set rngTwo = wksConstraints.Range("B2:B" & LastRow)
Set rtChart = Charts.Add
rtChart.Location Where:=xlLocationAsNewSheet, Name:="Setup"
With rtChart
.Name = "Setup"
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
End With
rtChart.SetSourceData Source:=wksConstraints.Range( _
rngOne.Address(False, False) & "," & rngTwo.Address(False, False)), PlotBy:=xlColumns
With rtChart
.ChartType = xlXYScatter
.HasTitle = True
.ChartTitle.Text = "Setup"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Material"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Hours"
End With
Set wksConstraints = Sheets("Zeroes " & Workcenter)
LastRow = wksConstraints.Cells(wksConstraints.Rows.Count, "A").End(xlUp).Row
Set rngOne = wksConstraints.Range("A2:A" & LastRow)
Set rngTwo = wksConstraints.Range("C2:C" & LastRow)
Set rtChart = Charts.Add
rtChart.Location Where:=xlLocationAsNewSheet, Name:="Run"
With rtChart
.Name = "Run"
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
End With
rtChart.SetSourceData Source:=wksConstraints.Range( _
rngOne.Address(False, False) & "," & rngTwo.Address(False, False)), PlotBy:=xlColumns
With rtChart
.ChartType = xlXYScatter
.HasTitle = True
.ChartTitle.Text = "Run"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Material"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Hours"
End With
Application.CutCopyMode = False
ActiveChart.Location Where:=xlLocationAsObject, Name:="Zeroes " & Workcenter
Dim RngToCover As Range
Dim ChtOb As ChartObject
Set RngToCover = ActiveSheet.Range("E17:L30")
Set ChtOb = ActiveChart.Parent
ChtOb.Height = RngToCover.Height ' resize
ChtOb.Width = RngToCover.Width ' resize
ChtOb.Top = RngToCover.Top ' reposition
ChtOb.Left = RngToCover.Left ' reposition
Sheets("Setup").Select
ActiveChart.Location Where:=xlLocationAsObject, Name:="Zeroes " & Workcenter
Set RngToCover = ActiveSheet.Range("E2:L15")
Set ChtOb = ActiveChart.Parent
ChtOb.Height = RngToCover.Height ' resize
ChtOb.Width = RngToCover.Width ' resize
ChtOb.Top = RngToCover.Top ' reposition
ChtOb.Left = RngToCover.Left ' reposition
Range("O4").FormulaR1C1 = WorksheetFunction.Average(Range("B:B"))
Range("O5").FormulaR1C1 = WorksheetFunction.Average(Range("C:C"))
Range("O6").FormulaR1C1 = WorksheetFunction.Average(Range("D:D"))
With Cells
.WrapText = False
.EntireColumn.AutoFit
.EntireRow.AutoFit
End With
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
Dim WC$
Dim LR As Long, i As Long
Dim strName As String
Application.ScreenUpdating = False
Workcenter = ListBox1.Value
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "No Zeroes " & Workcenter
Range("A1").FormulaR1C1 = "Material"
Range("B1").FormulaR1C1 = "Setup"
Range("C1").FormulaR1C1 = "Run"
Range("D1").FormulaR1C1 = "Amort"
Range("N4").FormulaR1C1 = "Average Setup"
Range("N5").FormulaR1C1 = "Average Run"
Range("N6").FormulaR1C1 = "Average Amort"
Sheets("Routings DJL").Activate
With ActiveSheet
LR = .Range("E" & Rows.Count).End(xlUp).Row
For i = 1 To LR
If .Range("E" & i).Value = Workcenter And .Range("F" & i).Value > 0 Then
.Range("A" & i).Copy
Sheets("No Zeroes " & Workcenter).Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
.Range("F" & i).Copy
Sheets("No Zeroes " & Workcenter).Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
.Range("G" & i).Copy
Sheets("No Zeroes " & Workcenter).Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
.Range("H" & i).Copy
Sheets("No Zeroes " & Workcenter).Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
Next i
End With
Sheets("No Zeroes " & Workcenter).Select
Dim wksConstraints As Worksheet
Dim rtChart As Chart
Dim LastRow As Long
Dim rngOne As Range, rngTwo As Range
Set wksConstraints = Sheets("No Zeroes " & Workcenter)
LastRow = wksConstraints.Cells(wksConstraints.Rows.Count, "A").End(xlUp).Row
Set rngOne = wksConstraints.Range("A2:A" & LastRow)
Set rngTwo = wksConstraints.Range("B2:B" & LastRow)
Set rtChart = Charts.Add
rtChart.Location Where:=xlLocationAsNewSheet, Name:="Setup"
With rtChart
.Name = "Setup"
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
End With
rtChart.SetSourceData Source:=wksConstraints.Range( _
rngOne.Address(False, False) & "," & rngTwo.Address(False, False)), PlotBy:=xlColumns
With rtChart
.ChartType = xlXYScatter
.HasTitle = True
.ChartTitle.Text = "Setup"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Material"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Hours"
End With
Set wksConstraints = Sheets("No Zeroes " & Workcenter)
LastRow = wksConstraints.Cells(wksConstraints.Rows.Count, "A").End(xlUp).Row
Set rngOne = wksConstraints.Range("A2:A" & LastRow)
Set rngTwo = wksConstraints.Range("C2:C" & LastRow)
Set rtChart = Charts.Add
rtChart.Location Where:=xlLocationAsNewSheet, Name:="Run"
With rtChart
.Name = "Run"
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
End With
rtChart.SetSourceData Source:=wksConstraints.Range( _
rngOne.Address(False, False) & "," & rngTwo.Address(False, False)), PlotBy:=xlColumns
With rtChart
.ChartType = xlXYScatter
.HasTitle = True
.ChartTitle.Text = "Run"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Material"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Hours"
End With
Application.CutCopyMode = False
ActiveChart.Location Where:=xlLocationAsObject, Name:="No Zeroes " & Workcenter
Dim RngToCover As Range
Dim ChtOb As ChartObject
Set RngToCover = ActiveSheet.Range("E17:L30")
Set ChtOb = ActiveChart.Parent
ChtOb.Height = RngToCover.Height ' resize
ChtOb.Width = RngToCover.Width ' resize
ChtOb.Top = RngToCover.Top ' reposition
ChtOb.Left = RngToCover.Left ' reposition
Sheets("Setup").Select
ActiveChart.Location Where:=xlLocationAsObject, Name:="No Zeroes " & Workcenter
Set RngToCover = ActiveSheet.Range("E2:L15")
Set ChtOb = ActiveChart.Parent
ChtOb.Height = RngToCover.Height ' resize
ChtOb.Width = RngToCover.Width ' resize
ChtOb.Top = RngToCover.Top ' reposition
ChtOb.Left = RngToCover.Left ' reposition
Range("O4").FormulaR1C1 = WorksheetFunction.Average(Range("B:B"))
Range("O5").FormulaR1C1 = WorksheetFunction.Average(Range("C:C"))
Range("O6").FormulaR1C1 = WorksheetFunction.Average(Range("D:D"))
With Cells
.WrapText = False
.EntireColumn.AutoFit
.EntireRow.AutoFit
End With
Application.ScreenUpdating = True
End Sub
The charts can be generated for some items in the listbox, but not all. If necessary I can post what is in the list box. Any idea why this is happening?
Bookmarks