Results 1 to 4 of 4
  1. #1
    New Lounger
    Join Date
    Mar 2003
    Location
    Venice, Florida, USA
    Posts
    9
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Speeding Up Code (2000 En)

    Hi,
    I have seen posts by BrianB and others on Google Groups, that
    refer to speedier code without .Select. I am a bit new to VB, so I am going
    to post some "slow" code here. Maybe someone has some ideas about speeding
    it up. It all works ok, just a might slow.

    Dim MyMonth, MySheet
    MySheet = Array("", "", "", "", "", "", "", "", "", "", "", "", "", "","", "", "", "", "", "", "", "", "", "", "")
    MyMonth = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", _
    "October", "November", "December")

    For i = 15 To Sheets.Count
    j = i - 15
    MySheet(j) = Sheets(i).Name
    Sheets(MySheet(j)).Select
    Sheets(MySheet(j)).Activate
    ActiveSheet.Cells.Select
    Selection.ClearContents
    With Selection.Font
    .Name = "Times New Roman"
    .FontStyle = "Regular"
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveSheet.Range("A3").Select
    Next i


    For CurMon = 0 To 11
    For i = 15 To Sheets.Count
    j = i - 15
    MySheet(j) = Sheets(i).Name
    Sheets(MyMonth(CurMon)).Range("G4") = MySheet(j)
    Sheets(MySheet(j)).Select
    ActiveSheet.Range("A3").Select

    If CurMon = 0 Then
    MyRange = "A3"
    Else
    If ActiveSheet.Range("A4").Value = "" Then
    ActiveCell.Offset(1, 0).Range("A1").Select
    Else
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    End If
    End If

    ActiveCell.FormulaR1C1 = MyMonth(CurMon)

    With Selection.Font
    .Name = "Times New Roman"
    .FontStyle = "Bold"
    .Size = 14
    End With
    ActiveCell.Range("A1:G1").Select
    With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
    End With
    ActiveCell.Offset(1, 0).Range("A1").Select
    MyRange = Selection.Address

    Sheets(MyMonth(CurMon)).Range("A6:G127").AdvancedF ilter
    Action:=xlFilterCopy, _
    CriteriaRange:=Sheets(MyMonth(CurMon)).Range("G3:G 4"),
    CopyToRange:=Range(MyRange), Unique:=False

    Next i
    Next CurMon
    For j = 0 To Sheets.Count - 15
    Sheets(MySheet(j)).Select
    ActiveSheet.Range("A3").Select
    ActiveCell.Columns("A:B").EntireColumn.Select
    Selection.Columns.ColumnWidth = 11
    ActiveCell.Columns("C").EntireColumn.Select
    Selection.Columns.ColumnWidth = 40
    ActiveSheet.Range("A3").Select
    ActiveCell.Columns("D:G").EntireColumn.Select
    Selection.Columns.ColumnWidth = 15
    ActiveSheet.Range("A3").Select
    Next j
    Sheets(1).Select
    Range("A3").Select

    End Sub


    TIA
    Todd

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Speeding Up Code (2000 En)

    Generally, code will indeed run faster if you don't select ranges; working wth range objects doesn't involve the overhead of changing the selection. I have changed the MyRange variable from a String to a Range.

    The MySheet array seems superfluous, you keep on filling it with the same data, but you might as well refer to the sheets directly.

    Here is the modified version of your code.

    Note: you'll have to test it carefully. Not knowing the exact structure of your workbook, I couldn't test it in action, I could only check it for syntactic correctness.

    Sub Test()
    Dim MyMonth
    Dim MyRange As Range
    Dim i As Integer
    Dim curmon As Integer

    MyMonth = Array("January", "February", "March", "April", "May", _
    "June", "July", "August", "September", "October", "November", "December")

    For i = 15 To Sheets.Count
    With Sheets(i).Cells
    .ClearContents
    With .Font
    .Name = "Times New Roman"
    .FontStyle = "Regular"
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    .Borders.LineStyle = xlNone
    End With
    Next i

    For curmon = 0 To 11
    For i = 15 To Sheets.Count
    Set MyRange = Sheets(i).Range("A3")

    If curmon > 0 Then
    If MyRange.Offset(1, 0) = "" Then
    Set MyRange = MyRange.Offset(1, 0)
    Else
    Set MyRange = MyRange.End(xlDown).Offset(1, 0)
    End If
    End If

    MyRange = MyMonth(curmon)

    With MyRange.Font
    .FontStyle = "Bold"
    .Size = 14
    End With

    With MyRange.Range("A1:G1")
    With .Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    End With
    With .Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    End With
    End With

    Set MyRange = MyRange.Offset(1, 0)

    Sheets(MyMonth(curmon)).Range("A6:G127").AdvancedF ilter _
    Action:=xlFilterCopy, _
    CriteriaRange:=Sheets(MyMonth(curmon)).Range("G3:G 4"), _
    CopyToRange:=MyRange, Unique:=False
    Next i
    Next curmon

    For i = 15 To Sheets.Count
    With Sheets(i)
    .Columns("A:B").ColumnWidth = 11
    .Columns("C").ColumnWidth = 40
    .Columns("D:G").ColumnWidth = 15
    End With
    Next i
    End Sub

  3. #3
    4 Star Lounger
    Join Date
    Dec 2000
    Location
    Faifax, Virginia, USA
    Posts
    542
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Speeding Up Code (2000 En)

    Hi Todd ~ here are a few questions i always ask about 'optimizing' working code:
    How "slow" is it?
    How many times is it executed?
    Who cares?
    Can I run it on a faster machine, and leave the code alone?

    In general, it is Good Practice

  4. #4
    New Lounger
    Join Date
    Mar 2003
    Location
    Venice, Florida, USA
    Posts
    9
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Speeding Up Code (2000 En)

    How "slow" is it?
    Not very, takes about 3 to 5 seconds on my AMD XP2000+ with 512MB.

    How many times is it executed?
    Not too often, maybe 50 to 75 times a year

    Who cares?
    Me. And hopefully numerous other people who are trying to learn vba, and become better coders. Although it is very hard to read someone else's mush when you are relatively new to any language, when an expert can make someone's code better, that person stands to learn a lot. This time, that was me. Hopefully someone else can also learn from the help afforded by yourself and Hans. For me, I really feel like I've come a long way with what this lesson has taught me.

    Can I run it on a faster machine, and leave the code alone?
    This, I hope, was a joke.

    "Should I spend some extra time and put out the best product I can, or put out a mediocre product and let others adapt?"

    I do not intend any disrespect here, (and by no means am I making money from this, it is gratis' for a local church) but whether I build Operating Systems or the simplest spreadsheet, I would hope this is not my attitude toward my task.

    Thanks for the tip on the loops, I have changed my code a little to incorporate this idea.

    I have, on the other hand, revamped several hundred lines of code to incorporate the use of ranges rather than selections. Big difference, in not just the number of lines required, but also the speed. I further picked up a trick with .Borders.LineStyle = xlNone rather than referring to each Border.

    Thanks so much for your time on this Hans, as well as yours Peter.

    TB

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •