herbertheien
New Member
- Joined
- Feb 17, 2009
- Messages
- 6
Hi,
I am sort of playing around with VBA. Currently I have set up two check boxes that are tied to macros that add in trend lines. The problem that I am having is that I want to uncheck the boxes and delete the proper trend lines. I realize that my code is a muck below, but someone would read through it and help me fix it that would be really nice. If there was a way to select an xlPolynomial, or and xlLinear Trend line, then I think I would be set.
I basically got all of my code online and pieced it together, and have been coding VBA now for about 3 days.
'----------------------------- Polynomial Trend Line ---------------------------------------
Sub trendline_poly()
On Error GoTo FileError
'Place this right before the line that may cause a file error
'Include File opening code here
On Error GoTo ErrorHandler 'Place this right after the line that may cause a file error to resume regular error handling
Dim myBox As CheckBox
Dim i As Integer
Dim j As Integer
Set Sh_1 = ActiveWorkbook.Sheets("Lists")
Set Sh_2 = ActiveWorkbook.Sheets("Utilization_by_Product_Only")
Set Sh_3 = ActiveWorkbook.Sheets("walk_product_macroneeds")
nCharts = ActiveSheet.ChartObjects.Count
i = 1
For Each myBox In ActiveSheet.CheckBoxes
myBox.LinkedCell = ActiveSheet.Range("M" & i).Address
i = i + 1
Next myBox
If Sh_2.Range("M1") = True Then
For iChart = 1 To nCharts
MinMaxNum = 4 + iChart
'Required to name chart objects, to do this hold shift and click
'on a chart, then give name in the name box hit enter
ActiveSheet.ChartObjects("UP" & iChart & "").Activate
ActiveChart.ChartArea.Select
SCount = ActiveChart.SeriesCollection.Count
With Sh_2.ChartObjects("UP" & iChart & "").Chart
ActiveChart.SeriesCollection(SCount).Trendlines.Add(Type:=xlPolynomial, Order:=6 _
, Forward:=0, Backward:=0, DisplayEquation:=False, DisplayRSquared:= _
False).Select
With Selection.Border
.ColorIndex = 4
.Weight = xlThin
.LineStyle = xlContinuous
End With
End With
Next
ActiveChart.Deselect
End If
' ActiveSheet.ChartObjects("Chart 2").Activate
' ActiveChart.ChartArea.Select
' Count1 = ActiveChart.SeriesCollection(1).Trendlines.Count
' If Count1 > 0 Then
' For i = 1 To Count1
' ActiveChart.SeriesCollection(1).Trendlines(1).delete
' Next
' End If
' Count2 = ActiveChart.SeriesCollection(2).Trendlines.Count
' If Count2 > 0 Then
' For i = 1 To Count2
' ActiveChart.SeriesCollection(2).Trendlines(1).delete
' Next
' End If
' ActiveWindow.Visible = False
If Sh_2.Range("M1") = False Then
For iChart = 1 To nCharts
MinMaxNum = 4 + iChart
ActiveSheet.ChartObjects("UP" & iChart & "").Activate
ActiveChart.ChartArea.Select
Count1 = ActiveChart.SeriesCollection(1).Trendlines.Count
If Count1 > 0 Then
For i = 1 To Count1
'If ActiveChart.SeriesCollection(1).Trendlines(2).Type = xlPolynomial Then
If 3 = xlPolynomial Then
ActiveChart.SeriesCollection(1).Trendlines(2).delete
End If
Next
End If
ActiveWindow.Visible = False
Next
ActiveChart.Deselect
End If
'--------------------------------------------------------------------------------
Exit Sub 'Include this line to unsure that if the code runs without problem it won’t hit the error handler
FileError:
'Include Your Error Handling For not being able to open the file
Exit Sub 'Include this line to unsure that if the code runs without problem it won’t hit the error handler
ErrorHandler:
'Include Your Error Handling Code Here
MsgBox "Error #" & Err.Number & " - " & Err.Description
Resume Next 'this will tell the Program to continue on with the rest of the code.
End Sub
'------------------------- Trendline Linear -----------------------------------
Sub trendline_line()
On Error GoTo FileError
'Place this right before the line that may cause a file error
'Include File opening code here
On Error GoTo ErrorHandler 'Place this right after the line that may cause a file error to resume regular error handling
Dim myBox As CheckBox
Dim i As Integer
Set Sh_1 = ActiveWorkbook.Sheets("Lists")
Set Sh_2 = ActiveWorkbook.Sheets("Utilization_by_Product_Only")
Set Sh_3 = ActiveWorkbook.Sheets("walk_product_macroneeds")
nCharts = ActiveSheet.ChartObjects.Count
i = 1
For Each myBox In ActiveSheet.CheckBoxes
myBox.LinkedCell = ActiveSheet.Range("M" & i).Address
i = i + 1
Next myBox
If Sh_2.Range("M2") = True Then
For iChart = 1 To nCharts
MinMaxNum = 4 + iChart
'Required to name chart objects, to do this hold shift and click
'on a chart, then give name in the name box hit enter
ActiveSheet.ChartObjects("UP" & iChart & "").Activate
ActiveChart.ChartArea.Select
With Sh_2.ChartObjects("UP" & iChart & "").Chart
ActiveChart.SeriesCollection(1).Trendlines.Add(Type:=xlLinear, _
Forward:=0, Backward:=0, DisplayEquation:=False, DisplayRSquared:= _
False).Select
' SCount = ActiveChart.SeriesCollection.Count
' ActiveChart.SeriesCollection(SCount).Trendlines(SCount).Select
With Selection.Border
.ColorIndex = 5
.Weight = xlThin
.LineStyle = xlContinuous
End With
End With
Next
ActiveChart.Deselect
End If
If Sh_2.Range("M2") = False Then
For iChart = 1 To nCharts
MinMaxNum = 4 + iChart
ActiveSheet.ChartObjects("UP" & iChart & "").Activate
ActiveChart.ChartArea.Select
Count1 = ActiveChart.SeriesCollection(1).Trendlines.Count
SCount = ActiveChart.SeriesCollection.Count
If Count1 > 0 Then
For i = 1 To Count1
If ActiveChart.SeriesCollection(SCount).Trendlines(SCount).Type = xlLinear Then
ActiveChart.SeriesCollection(SCount).Trendlines(SCount).delete
End If
Next
End If
' Count2 = ActiveChart.SeriesCollection(2).Trendlines.Count
' If Count2 > 0 Then
' For i = 1 To Count2
' ActiveChart.SeriesCollection(2).Trendlines(1).delete
' Next
' End If
ActiveWindow.Visible = False
Next
'ActiveChart.Deselect
End If
'--------------------------------------------------------------------------------
Exit Sub 'Include this line to unsure that if the code runs without problem it won’t hit the error handler
FileError:
'Include Your Error Handling For not being able to open the file
Exit Sub 'Include this line to unsure that if the code runs without problem it won’t hit the error handler
ErrorHandler:
'Include Your Error Handling Code Here
MsgBox "Error #" & Err.Number & " - " & Err.Description
Resume Next 'this will tell the Program to continue on with the rest of the code.
End Sub
I am sort of playing around with VBA. Currently I have set up two check boxes that are tied to macros that add in trend lines. The problem that I am having is that I want to uncheck the boxes and delete the proper trend lines. I realize that my code is a muck below, but someone would read through it and help me fix it that would be really nice. If there was a way to select an xlPolynomial, or and xlLinear Trend line, then I think I would be set.
I basically got all of my code online and pieced it together, and have been coding VBA now for about 3 days.
'----------------------------- Polynomial Trend Line ---------------------------------------
Sub trendline_poly()
On Error GoTo FileError
'Place this right before the line that may cause a file error
'Include File opening code here
On Error GoTo ErrorHandler 'Place this right after the line that may cause a file error to resume regular error handling
Dim myBox As CheckBox
Dim i As Integer
Dim j As Integer
Set Sh_1 = ActiveWorkbook.Sheets("Lists")
Set Sh_2 = ActiveWorkbook.Sheets("Utilization_by_Product_Only")
Set Sh_3 = ActiveWorkbook.Sheets("walk_product_macroneeds")
nCharts = ActiveSheet.ChartObjects.Count
i = 1
For Each myBox In ActiveSheet.CheckBoxes
myBox.LinkedCell = ActiveSheet.Range("M" & i).Address
i = i + 1
Next myBox
If Sh_2.Range("M1") = True Then
For iChart = 1 To nCharts
MinMaxNum = 4 + iChart
'Required to name chart objects, to do this hold shift and click
'on a chart, then give name in the name box hit enter
ActiveSheet.ChartObjects("UP" & iChart & "").Activate
ActiveChart.ChartArea.Select
SCount = ActiveChart.SeriesCollection.Count
With Sh_2.ChartObjects("UP" & iChart & "").Chart
ActiveChart.SeriesCollection(SCount).Trendlines.Add(Type:=xlPolynomial, Order:=6 _
, Forward:=0, Backward:=0, DisplayEquation:=False, DisplayRSquared:= _
False).Select
With Selection.Border
.ColorIndex = 4
.Weight = xlThin
.LineStyle = xlContinuous
End With
End With
Next
ActiveChart.Deselect
End If
' ActiveSheet.ChartObjects("Chart 2").Activate
' ActiveChart.ChartArea.Select
' Count1 = ActiveChart.SeriesCollection(1).Trendlines.Count
' If Count1 > 0 Then
' For i = 1 To Count1
' ActiveChart.SeriesCollection(1).Trendlines(1).delete
' Next
' End If
' Count2 = ActiveChart.SeriesCollection(2).Trendlines.Count
' If Count2 > 0 Then
' For i = 1 To Count2
' ActiveChart.SeriesCollection(2).Trendlines(1).delete
' Next
' End If
' ActiveWindow.Visible = False
If Sh_2.Range("M1") = False Then
For iChart = 1 To nCharts
MinMaxNum = 4 + iChart
ActiveSheet.ChartObjects("UP" & iChart & "").Activate
ActiveChart.ChartArea.Select
Count1 = ActiveChart.SeriesCollection(1).Trendlines.Count
If Count1 > 0 Then
For i = 1 To Count1
'If ActiveChart.SeriesCollection(1).Trendlines(2).Type = xlPolynomial Then
If 3 = xlPolynomial Then
ActiveChart.SeriesCollection(1).Trendlines(2).delete
End If
Next
End If
ActiveWindow.Visible = False
Next
ActiveChart.Deselect
End If
'--------------------------------------------------------------------------------
Exit Sub 'Include this line to unsure that if the code runs without problem it won’t hit the error handler
FileError:
'Include Your Error Handling For not being able to open the file
Exit Sub 'Include this line to unsure that if the code runs without problem it won’t hit the error handler
ErrorHandler:
'Include Your Error Handling Code Here
MsgBox "Error #" & Err.Number & " - " & Err.Description
Resume Next 'this will tell the Program to continue on with the rest of the code.
End Sub
'------------------------- Trendline Linear -----------------------------------
Sub trendline_line()
On Error GoTo FileError
'Place this right before the line that may cause a file error
'Include File opening code here
On Error GoTo ErrorHandler 'Place this right after the line that may cause a file error to resume regular error handling
Dim myBox As CheckBox
Dim i As Integer
Set Sh_1 = ActiveWorkbook.Sheets("Lists")
Set Sh_2 = ActiveWorkbook.Sheets("Utilization_by_Product_Only")
Set Sh_3 = ActiveWorkbook.Sheets("walk_product_macroneeds")
nCharts = ActiveSheet.ChartObjects.Count
i = 1
For Each myBox In ActiveSheet.CheckBoxes
myBox.LinkedCell = ActiveSheet.Range("M" & i).Address
i = i + 1
Next myBox
If Sh_2.Range("M2") = True Then
For iChart = 1 To nCharts
MinMaxNum = 4 + iChart
'Required to name chart objects, to do this hold shift and click
'on a chart, then give name in the name box hit enter
ActiveSheet.ChartObjects("UP" & iChart & "").Activate
ActiveChart.ChartArea.Select
With Sh_2.ChartObjects("UP" & iChart & "").Chart
ActiveChart.SeriesCollection(1).Trendlines.Add(Type:=xlLinear, _
Forward:=0, Backward:=0, DisplayEquation:=False, DisplayRSquared:= _
False).Select
' SCount = ActiveChart.SeriesCollection.Count
' ActiveChart.SeriesCollection(SCount).Trendlines(SCount).Select
With Selection.Border
.ColorIndex = 5
.Weight = xlThin
.LineStyle = xlContinuous
End With
End With
Next
ActiveChart.Deselect
End If
If Sh_2.Range("M2") = False Then
For iChart = 1 To nCharts
MinMaxNum = 4 + iChart
ActiveSheet.ChartObjects("UP" & iChart & "").Activate
ActiveChart.ChartArea.Select
Count1 = ActiveChart.SeriesCollection(1).Trendlines.Count
SCount = ActiveChart.SeriesCollection.Count
If Count1 > 0 Then
For i = 1 To Count1
If ActiveChart.SeriesCollection(SCount).Trendlines(SCount).Type = xlLinear Then
ActiveChart.SeriesCollection(SCount).Trendlines(SCount).delete
End If
Next
End If
' Count2 = ActiveChart.SeriesCollection(2).Trendlines.Count
' If Count2 > 0 Then
' For i = 1 To Count2
' ActiveChart.SeriesCollection(2).Trendlines(1).delete
' Next
' End If
ActiveWindow.Visible = False
Next
'ActiveChart.Deselect
End If
'--------------------------------------------------------------------------------
Exit Sub 'Include this line to unsure that if the code runs without problem it won’t hit the error handler
FileError:
'Include Your Error Handling For not being able to open the file
Exit Sub 'Include this line to unsure that if the code runs without problem it won’t hit the error handler
ErrorHandler:
'Include Your Error Handling Code Here
MsgBox "Error #" & Err.Number & " - " & Err.Description
Resume Next 'this will tell the Program to continue on with the rest of the code.
End Sub