Looping a macro, filtering

**mettekr** · 10-27-2008, 03:28 PM

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:

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

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.

Thanks

**MatrixMan** · 10-27-2008, 03:43 PM

To be perfectly honest ... this is a bit of mess

But fret not! I see what you're trying to do; this is one of the limitations of the record feature - great for discovering the properties & methods you need, not so good at repeating things or doing things in the most efficient way.

To really deliver a solution that will be robust, I need to see your full workbook ... if you attach it I'll take a look & re-code this for you.

Hope this helps. MM.

**mettekr** · 10-28-2008, 09:25 AM

MatrixMan, you may end up a hero. And I'm quite new to VBA, recording is about the best I can do, then adding a few things myself to make it seem like I know what I'm doing :-). Here's the workbook.

Thanks a ton

**MatrixMan** · 10-28-2008, 11:00 AM

LOL ... well, happy to help

Quick question for you: are you sure you want the charts & data displayed within a sheet as you've done it in the example? i.e. would you prefer the charts established as separate chart sheets? If you just want it exactly per your example that's fine ... just let me know if you've done it that way for a reason ...

**mettekr** · 10-28-2008, 11:56 AM

That was just they way I happened to make it. These are going to go into two quadrants of a powerpoint slide, so I put them there because they stayed small. As more months of data start coming in, having it on a new sheet may be smarter. Also, I probably should have clarified since I had my first version of the macro in there too. The on I run is "Do_All" which calls Modules 2 and 3. Did my "lastrow" variable make sense? In this case you'd put 10 so that the charts are made with data through row 10...probably a better way again, but that was a variable I knew at the time.

Thanks again1

**MatrixMan** · 10-28-2008, 12:16 PM

OK - no problem ... so I'll put all the charts into a single sheet then; and your last row thing was a bit of a puzzle - I've determined the full range for each lane ID dynamically ... I'm almost done; should be able to post it within the hour. Final question: did you not want to chart the last column "MTD SCOS" on purpose? Easy fix .. just let me know.

**mettekr** · 10-29-2008, 01:27 PM

Ok, I added a tab called 2nd chart sample to show what I meant. Looking back on what I typed, I'm not surprised it didn't make sense...
The other tabs have the charts the way I needed them too (partially done by a workaround you'll see in the code until I figure out the range settings)

**MatrixMan** · 10-29-2008, 05:14 PM

Hi again ... a few things that might help:

1. I can't really see what you're trying to do with the 2nd chart; the primary data is charted for just 1 month, while the target is over 3 months and incorrectly laid across the three primary data points. Is this a workaround or what you actually want?

2. Regarding your workaround commented in the code, try using the names associated with the series collection; you're currently deleting all series above the 6th and then formatting the 6th one. If you are sure this is what you want, you could use something like:

    ActiveSheet.Shapes(1).Select
    While Not ActiveChart.SeriesCollection(7) Is Nothing
        ActiveChart.SeriesCollection(7).Delete
    Wend

But it's preferable that if you really want to do this, you select each range you want to delete explicitly (I've stored the names in the array for you, so just cylce through it until you get to the one/s you want). Alternatively ... just don't include the data in the range in the first place.

3. You might find the code below useful for repositioning your charts within the available window.

Private Sub MoveChartTopLeftAndResizeToHalfWindow(intChartIndex, strSheetName)
Dim intWindowHeight As Integer, intWindowWidth As Integer
    intWindowHeight = ActiveWindow.Height
    intWindowWidth = ActiveWindow.Width
    With ThisWorkbook.Worksheets(strSheetName).ChartObjects(intChartIndex)
        'this sets it to 1/2 the avail. height/width; but change the multiplier to suit:
        .Width = intWindowWidth * 0.5
        .Height = intWindowHeight * 0.5
        .Left = 0
        .Top = 0
    End With
End Sub

Hope that helps. MM.

**mettekr** · 10-29-2008, 08:05 PM

Ok, I'll test out what you've got there when I get back to work in the morning. As for the format of that second chart, it is a weird way of getting what I want...the 2007 and 2008 data is going to be the same for a given lane everytime, and when I update the MTD SCOS on the MTD SCOS tab, it will change the MTD SCOS column for every lane, so that will be the same for the lane too in a way. So what that 2nd graph will show is how many days the transit took in 2007, how long the average was for the first half of 2008 (the June number), and then the average (MTD SCOS) since July. Then the data going across the 3 is the 2010 goal. I guess having that go across the 3 is a workaround for showing a benchmark. Don't know if that cleared anything up or not. I'll check back in tomorrow.