StuLythgoe
New Member
- Joined
- Oct 2, 2011
- Messages
- 36
I have for the past month been learning the beautiful art of VBA. To make work a little more palatable I have written/recorded some procedures to vastly speed up the production of some reports completed on a regular basis. I wrote a procedure which is outlined below to produce a chart on Sheet2 from some data on Sheet1 and it works fine. As I have only just started with VBA I have been trying to add in some error handling and to tidy the code up and make it far more efficient and now for some reason the newer procedure doesn't quite work as it should. The chart labels should be changed to a smaller font, which doesn't happen, but all the code around these lines gets actioned. I tried debugging the code and it got ever more the stranger. The code works in Debug mode until I get to inserting a row into the sheet on which the Chart is stored and then I get Run-time error '1004': Method 'Rows' of object '_global' failed for a line of code that I have recreated with the Macro recorder and which works fine outside of this procedure, so I'm thinking due to my lack of knowledge and experience that I must have written or edited something earlier which is now giving rise to this error. I'm therefore hoping that someone might be able to give me a little assistance with this.
Thanks in Advance
Stu
Old Working version of procedure
Rewritten procedure
Thanks in Advance
Stu
Old Working version of procedure
Code:
Sub Maintenance()
'
Dim Book1 As String
Dim EndCell As String
Dim TotalRange As String
Dim TotalRange2 As String
Dim Path As String
Dim StartTime As Double
Path = InputBox("Enter details of path to folder containing report - (eg. S:\Stocks & Systems\Systems\Monday Reports\280811", "Path to File?")
Book1 = Path & "\Component Summary.xls"
StartTime = Timer
Workbooks.Open Filename:=[Book1]
Range("A1").Select
Do
ActiveCell.Offset(1, 0).Range("A1").Select
Loop Until ActiveCell.Value = 0
ActiveCell.Offset(-1, 1).Range("A1").Select
EndCell = ActiveCell.Range("A1").Address
TotalRange = "B2" & ":" & EndCell
TotalRange2 = "A1" & ":" & EndCell
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Range("B1").Select
ActiveCell.FormulaR1C1 = "Total Cost"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=RC[1]*1"
Range("B2").Select
Selection.Autofill Destination:=Range(TotalRange)
Range(TotalRange).Select
Columns("A:C").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("B:B").Select
Selection.ColumnWidth = 9.6
Columns("C:C").Select
Selection.EntireColumn.Hidden = True
Range(TotalRange2).Select
Range(EndCell).Activate
Sheets("Sheet1").Select
Sheets.Add
Sheets("Sheet1").Select
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range(TotalRange2), PlotBy _
:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet2"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Total Cost"
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
ActiveSheet.Shapes("Chart 1").IncrementLeft -219#
ActiveSheet.Shapes("Chart 1").IncrementTop -141.75
ActiveSheet.Shapes("Chart 1").ScaleWidth 1.95, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 1").ScaleHeight 1.93, msoFalse, msoScaleFromTopLeft
ActiveChart.Axes(xlValue).Select
Selection.TickLabels.AutoScaleFont = True
With Selection.TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
ActiveChart.Axes(xlCategory).Select
Selection.TickLabels.AutoScaleFont = True
With Selection.TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
ActiveChart.Axes(xlValue).MajorGridlines.Select
Selection.Delete
ActiveChart.Legend.Select
Selection.Delete
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).ApplyDataLabels AutoText:=True, LegendKey:= _
False, ShowSeriesName:=False, ShowCategoryName:=False, ShowValue:=True, _
ShowPercentage:=False, ShowBubbleSize:=False
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
.Position = xlLabelPositionOutsideEnd
.Orientation = xlUpward
End With
Sheets("Sheet2").Activate
Sheets("Sheet2").Rows("1:1").Select
Selection.Insert Shift:=xlDown
Rows("1:1").RowHeight = 21
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 12
End With
Rows("1:1").EntireRow.AutoFit
Range("A1:S1").Select
With Selection
.HorizontalAlignment = xlCenter
.MergeCells = True
End With
ActiveCell.FormulaR1C1 = "Sheet Creation automated using VBA in Excel (in " & Format(Timer - StartTime, "00.00") & " seconds)"
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ChartArea.Select
End Sub
Rewritten procedure
Code:
Sub Maintenance()
'
Dim Path As String
Dim Book1 As String, EndCell As String, TotalRange As String, TotalRange2 As String
Dim StartTime As Double
Path = InputBox("Enter details of path to folder containing report - (eg. S:\Stocks & Systems\Systems\Monday Reports\280811", "Path to File?")
If Path = "" Then Exit Sub
Book1 = Path & "\Component Summary.xls"
Application.ScreenUpdating = False
StartTime = Timer
'On Error GoTo Handler:
Workbooks.Open Filename:=[Book1]
Range("A:A").End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
EndCell = ActiveCell.Range("A1").Address
TotalRange = "B2" & ":" & EndCell
TotalRange2 = "A1" & ":" & EndCell
Columns("B:B").Insert Shift:=xlToRight
Range("B1").Value = "Total Cost"
Range("B2").Value = "=RC[1]*1"
Range("B2").AutoFill Destination:=Range(TotalRange)
Columns("A:C").Sort Key1:=Range("B2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("B:B").ColumnWidth = 9.6
Columns("C:C").EntireColumn.Hidden = True
Range(TotalRange2).Select
Range(EndCell).Activate
Sheets.Add
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range(TotalRange2), PlotBy _
:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet2"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Total Cost"
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With
ActiveSheet.Shapes("Chart 1").IncrementLeft -219#
ActiveSheet.Shapes("Chart 1").IncrementTop -141.75
ActiveSheet.Shapes("Chart 1").ScaleWidth 1.95, msoFalse, msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 1").ScaleHeight 1.93, msoFalse, msoScaleFromTopLeft
With ActiveChart.Axes(xlValue).TickLabels
.AutoScaleFont = True
.Font.Size = 8
End With
With ActiveChart.Axes(xlCategory).TickLabels
.AutoScaleFont = True
.Font.Size = 8
End With
ActiveChart.Axes(xlValue).MajorGridlines.Delete
ActiveChart.Legend.Delete
ActiveChart.SeriesCollection(1).ApplyDataLabels ShowValue:=True
With ActiveChart.SeriesCollection(1).DataLabels
.AutoScaleFont = True
.Font.Size = 8
.Orientation = xlUpward
End With
Sheets("Sheet2").Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Rows("1:1").RowHeight = 21
Rows("1:1").Font.Bold = True
Rows("1:1").Font.Name = "Arial"
Rows("1:1").Font.Size = 12
Rows("1:1").EntireRow.AutoFit
Range("A1:S1").Select
With Selection
.HorizontalAlignment = xlCenter
.MergeCells = True
End With
ActiveCell.FormulaR1C1 = "Sheet Creation automated using VBA in Excel (in " & Format(Timer - StartTime, "00.00") & " seconds)"
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ChartArea.Select
Application.ScreenUpdating = True
Handler:
If Err.Number = "1004" Then Exit Sub
End Sub