Code posted below my plea for help! VBA newbie here!
I have large amounts of data that I am exporting and subsequently analyzing. While columns and headers will always be the same, rows will not. I have created a macro to sort the data and break it into separate sheets, but the one piece I have not been able to do is to create a chart on each newly created sheet. I am dealing with Excel 2007.
For the chart, I want to create a graph that has variables on separate axis. The main trouble I am running into is the dynamic nature of the rows, which thus changes the data ranges to be graphed. Another challenge has been that the data is not in contiguous columns. Finally, I am concerned that the Dim for LastRow2 will need to be reset as a new sheet is created, but I haven't gotten that far yet.
The parts I need help with are the sections:
'Create chart
'Clear Series
'Add X & Y
What I tried to do was create a line chart, clear out the series of a meaningless range, and program it from there (4 variables, 2 on one axis, 2 on the other). Needless to say I cannot get it to work.
CAN ANYONE HELP?!? Thanks! Code as follows:
Sub ln_weld()
'Defining Last Row
Dim LastRow As Integer
LastRow = Range("A" & Rows.Count).End(xlUp).Row
'Inserting "time code" as "code1"
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Range("D2").Select
ActiveCell.FormulaR1C1 = "code1"
Range("D3").Select
ActiveCell.FormulaR1C1 = "=value(RC[-3]&"":""&RC[-2]&"":""&RC[-1])"
Range("D3").Select
Selection.Copy
Range("D3:D" & LastRow).Select
ActiveSheet.Paste
'Inserting "Position and Program" as "code2"
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Range("G2").Select
ActiveCell.FormulaR1C1 = "code2"
Range("G3").Select
ActiveCell.FormulaR1C1 = "=RC[-1]&""--""&RC[-2]"
Range("G3").Select
Selection.Copy
Range("G3:G" & LastRow).Select
ActiveSheet.Paste
'Sorting
Range("A2:AG" & LastRow).Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range( _
"G3:G" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range( _
"D3:D" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A2:AG" & LastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("D3").Select
'Copy & Paste Values
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Splitting Sheets
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String
Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
Set rRange = Range("G2", Range("G65536").End(xlUp))
On Error Resume Next
Application.DisplayAlerts = False
Worksheets.Add().Name = "UniqueList"
With Worksheets("UniqueList")
rRange.AdvancedFilter xlFilterCopy, , _
Worksheets("UniqueList").Range("A1"), True
Set rRange = .Range("A2", .Range("A65536").End(xlUp))
End With
On Error Resume Next
With wSheetStart
For Each rCell In rRange
strText = rCell
.Range("G2").AutoFilter 7, strText
Worksheets(strText).Delete
'Add a sheet named as content of rCell
Worksheets.Add().Name = strText
'Copy the visible filtered range _
(default of Copy Method) and leave hidden rows
.UsedRange.Copy Destination:=ActiveSheet.Range("A1")
ActiveSheet.Cells.Columns.AutoFit
'Create chart
With ActiveSheet.ChartObjects.Add _
(Left:=100, Width:=375, Top:=75, Height:=225)
.Chart.SetSourceData Source:=Sheets("Sheet1").Range("A3:G14")
.Chart.ChartType = xlLine
End With
'Clear Series
With ActiveChart
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
End With
'Add X & Y
Dim LastRow2 As Integer
LastRow2 = Range("A" & Rows.Count).End(xlUp).Row
With ActiveChart.SeriesCollection.NewSeries
.Name = ActiveSheet.Range("H2")
.Values = ActiveSheet.Range("H3:H" & LastRow2)
.XValues = ActiveSheet.Range("D3:D" & LastRow2)
End With
With ActiveChart.SeriesCollection.NewSeries
.Name = ActiveSheet.Range("K2")
.Values = ActiveSheet.Range("K3:K" & LastRow2)
.XValues = ActiveSheet.Range("D3:D" & LastRow2)
End With
With ActiveChart.SeriesCollection.NewSeries
.Name = ActiveSheet.Range("I2")
.Values = ActiveSheet.Range("I3:I" & LastRow2)
.XValues = ActiveSheet.Range("D3:D" & LastRow2)
End With
With ActiveChart.SeriesCollection.NewSeries
.Name = ActiveSheet.Range("L2")
.Values = ActiveSheet.Range("L3:L" & LastRow2)
.XValues = ActiveSheet.Range("D3:D" & LastRow2)
End With
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).AxisGroup = 2
ActiveChart.SeriesCollection(4).Select
ActiveChart.SeriesCollection(4).AxisGroup = 2
'Move On to Next Sheet
Next rCell
End With
With wSheetStart
.AutoFilterMode = False
.Activate
End With
On Error GoTo 0
Application.DisplayAlerts = True
End Sub
I have large amounts of data that I am exporting and subsequently analyzing. While columns and headers will always be the same, rows will not. I have created a macro to sort the data and break it into separate sheets, but the one piece I have not been able to do is to create a chart on each newly created sheet. I am dealing with Excel 2007.
For the chart, I want to create a graph that has variables on separate axis. The main trouble I am running into is the dynamic nature of the rows, which thus changes the data ranges to be graphed. Another challenge has been that the data is not in contiguous columns. Finally, I am concerned that the Dim for LastRow2 will need to be reset as a new sheet is created, but I haven't gotten that far yet.
The parts I need help with are the sections:
'Create chart
'Clear Series
'Add X & Y
What I tried to do was create a line chart, clear out the series of a meaningless range, and program it from there (4 variables, 2 on one axis, 2 on the other). Needless to say I cannot get it to work.
CAN ANYONE HELP?!? Thanks! Code as follows:
Sub ln_weld()
'Defining Last Row
Dim LastRow As Integer
LastRow = Range("A" & Rows.Count).End(xlUp).Row
'Inserting "time code" as "code1"
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Range("D2").Select
ActiveCell.FormulaR1C1 = "code1"
Range("D3").Select
ActiveCell.FormulaR1C1 = "=value(RC[-3]&"":""&RC[-2]&"":""&RC[-1])"
Range("D3").Select
Selection.Copy
Range("D3:D" & LastRow).Select
ActiveSheet.Paste
'Inserting "Position and Program" as "code2"
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Range("G2").Select
ActiveCell.FormulaR1C1 = "code2"
Range("G3").Select
ActiveCell.FormulaR1C1 = "=RC[-1]&""--""&RC[-2]"
Range("G3").Select
Selection.Copy
Range("G3:G" & LastRow).Select
ActiveSheet.Paste
'Sorting
Range("A2:AG" & LastRow).Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range( _
"G3:G" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range( _
"D3:D" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A2:AG" & LastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("D3").Select
'Copy & Paste Values
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Splitting Sheets
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String
Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
Set rRange = Range("G2", Range("G65536").End(xlUp))
On Error Resume Next
Application.DisplayAlerts = False
Worksheets.Add().Name = "UniqueList"
With Worksheets("UniqueList")
rRange.AdvancedFilter xlFilterCopy, , _
Worksheets("UniqueList").Range("A1"), True
Set rRange = .Range("A2", .Range("A65536").End(xlUp))
End With
On Error Resume Next
With wSheetStart
For Each rCell In rRange
strText = rCell
.Range("G2").AutoFilter 7, strText
Worksheets(strText).Delete
'Add a sheet named as content of rCell
Worksheets.Add().Name = strText
'Copy the visible filtered range _
(default of Copy Method) and leave hidden rows
.UsedRange.Copy Destination:=ActiveSheet.Range("A1")
ActiveSheet.Cells.Columns.AutoFit
'Create chart
With ActiveSheet.ChartObjects.Add _
(Left:=100, Width:=375, Top:=75, Height:=225)
.Chart.SetSourceData Source:=Sheets("Sheet1").Range("A3:G14")
.Chart.ChartType = xlLine
End With
'Clear Series
With ActiveChart
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
End With
'Add X & Y
Dim LastRow2 As Integer
LastRow2 = Range("A" & Rows.Count).End(xlUp).Row
With ActiveChart.SeriesCollection.NewSeries
.Name = ActiveSheet.Range("H2")
.Values = ActiveSheet.Range("H3:H" & LastRow2)
.XValues = ActiveSheet.Range("D3:D" & LastRow2)
End With
With ActiveChart.SeriesCollection.NewSeries
.Name = ActiveSheet.Range("K2")
.Values = ActiveSheet.Range("K3:K" & LastRow2)
.XValues = ActiveSheet.Range("D3:D" & LastRow2)
End With
With ActiveChart.SeriesCollection.NewSeries
.Name = ActiveSheet.Range("I2")
.Values = ActiveSheet.Range("I3:I" & LastRow2)
.XValues = ActiveSheet.Range("D3:D" & LastRow2)
End With
With ActiveChart.SeriesCollection.NewSeries
.Name = ActiveSheet.Range("L2")
.Values = ActiveSheet.Range("L3:L" & LastRow2)
.XValues = ActiveSheet.Range("D3:D" & LastRow2)
End With
ActiveChart.SeriesCollection(2).Select
ActiveChart.SeriesCollection(2).AxisGroup = 2
ActiveChart.SeriesCollection(4).Select
ActiveChart.SeriesCollection(4).AxisGroup = 2
'Move On to Next Sheet
Next rCell
End With
With wSheetStart
.AutoFilterMode = False
.Activate
End With
On Error GoTo 0
Application.DisplayAlerts = True
End Sub