Chart generation working for certain listbox values, but not all

**dale.lebar** · 06-28-2012, 12:20 PM

Here's the code I have come up with, I franksteined it from all kinds of different posts online:

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?