Hi everyone. I have created a macro to filter results from a set of data, paste that data to a new file, and then create charts based on that data. Right now, my macro is basically multiplied 20 times to do this for each heading. Is there a way to create a loop that will just redo the same macro but for the next data heading? Here is a sample of the first part of the macro:
Then it repeats for the next one, but with USAU in place of USAE and Book2 in place of Book1. It doesn't even all fit in one module, I had to make two. And it's really a pain if I want to make an edit to the code. I'd love some help.![]()
Sub new_files() lastrow = InputBox("Last Row Number for Creating Graphs", "Row") 'USAE Range("A2").Select Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Range("A1").Select Selection.AutoFilter Selection.AutoFilter Field:=2, Criteria1:="USAE" Workbooks.Add Windows("Top 20 Lanes.xls").Activate Columns("A:L").Select Selection.Copy Windows("Book1").Activate Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Columns("A:A").Select Application.CutCopyMode = False Selection.NumberFormat = "mmm-yy" Columns("B:B").Select Selection.Cut Columns("A:A").Select Selection.Insert Shift:=xlToRight Range("B1:F" & lastrow).Select Charts.Add ActiveChart.ChartType = xlColumnStacked ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("B1:F" & lastrow), PlotBy _ :=xlColumns ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(5).Values = "=Sheet1!R2C7:R10C7" ActiveChart.SeriesCollection(5).Name = "=Sheet1!R1C7" ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1" ActiveChart.HasLegend = True ActiveChart.Legend.Select Selection.Position = xlBottom ActiveChart.SeriesCollection(5).Select ActiveChart.SeriesCollection(5).AxisGroup = 2 ActiveChart.SeriesCollection(5).ChartType = xlLineMarkers ActiveChart.Axes(xlCategory).Select With Selection.Border .Weight = xlHairline .LineStyle = xlAutomatic End With With Selection .MajorTickMark = xlOutside .MinorTickMark = xlNone .TickLabelPosition = xlLow End With ActiveChart.PlotArea.Select ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(6).Values = "=Sheet1!R2C11:R10C11" ActiveChart.SeriesCollection(6).Name = "=Sheet1!R1C11" ActiveChart.SeriesCollection(6).Select ActiveChart.SeriesCollection(6).ChartType = xlLineMarkers ActiveChart.SeriesCollection(6).Select With Selection.Border .ColorIndex = 57 .Weight = xlThick .LineStyle = xlContinuous End With With Selection .MarkerBackgroundColorIndex = xlAutomatic .MarkerForegroundColorIndex = xlAutomatic .MarkerStyle = xlSquare .Smooth = False .MarkerSize = 9 .Shadow = False End With ActiveWindow.Visible = False Windows("Book1").Activate Range("I1:J2,L1:L2").Select Range("L1").Activate Charts.Add ActiveChart.ChartType = xlColumnClustered ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("I1:J2,L1:L2"), _ PlotBy:=xlRows ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(2).Values = "=Sheet1!R2C11" ActiveChart.SeriesCollection(2).Name = "=Sheet1!R1C11" ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1" ActiveChart.HasLegend = False ActiveSheet.Shapes("Chart 2").IncrementLeft -16.5 ActiveSheet.Shapes("Chart 2").IncrementTop 705# ActiveChart.SeriesCollection(2).Select ActiveChart.SeriesCollection(2).ChartType = xlLineMarkers Windows("Book1").SmallScroll Down:=-15 ActiveChart.SeriesCollection(2).Select ActiveChart.SeriesCollection(2).Values = "=Sheet1!R2C11:R4C11" Windows("Book1").SmallScroll Down:=9 ActiveWindow.Visible = False Windows("Book1").Activate ActiveSheet.ChartObjects("Chart 1").Activate ActiveChart.Axes(xlCategory).Select With Selection.Border .Weight = xlHairline .LineStyle = xlAutomatic End With With Selection .MajorTickMark = xlOutside .MinorTickMark = xlNone .TickLabelPosition = xlLow End With Selection.TickLabels.AutoScaleFont = True With Selection.TickLabels.Font .Name = "Arial" .FontStyle = "Regular" .Size = 9 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .Background = xlAutomatic End With ActiveChart.Legend.Select Selection.AutoScaleFont = True With Selection.Font .Name = "Arial" .FontStyle = "Regular" .Size = 9 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .Background = xlAutomatic End With ActiveChart.Axes(xlValue, xlSecondary).Select Selection.TickLabels.AutoScaleFont = True With Selection.TickLabels.Font .Name = "Arial" .FontStyle = "Regular" .Size = 9 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .Background = xlAutomatic End With ActiveChart.Axes(xlValue).Select Selection.TickLabels.AutoScaleFont = True With Selection.TickLabels.Font .Name = "Arial" .FontStyle = "Regular" .Size = 9 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic .Background = xlAutomatic End With Windows("Book1").SmallScroll Down:=-21 ActiveWindow.Visible = False ActiveWorkbook.SaveAs Filename:= _ "C:\Documents and Settings\mettekr\Desktop\Top 20 Lanes\USAE.xls", FileFormat:= _ xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ , CreateBackup:=False ActiveWindow.Close Windows("Top 20 Lanes.xls").Activate
Thanks











LinkBack URL
About LinkBacks
Register To Reply
Bookmarks