Speed Up Excel VBA

[mac7attack]

Hi

Is there a way to speed up an Excel macro? I am already using ScreenUpdating = False. My spreadsheet that I am using has 270 rows but the true spreadsheet will have over 1500 rows.

Is this possible or am i going to have to deal with it?

Thanks in advance,
MAC

 

[SkipVought]

How Can I Make My Code Run Faster? faq707-4105

Skip,

_{[red]A palindrome gone wrong?[/red]
A man, a plan, a ROOT canal...
PULLEMALL!}

 

[fredericofonseca]

And apart from what the faq points to without knowing what you code is doing it is impossible to tell you for sure it can be any faster.

Next time (or even now) post your code so we can see what can be improved.
For example if you are loading records from a ADO source and are looping through each record to place it on the destination cells, then the use of copyfromrecordset method may be of help.

other things can be said, but only after looking at your code.

Regards

Frederico Fonseca
SysSoft Integrated Ltd

http://www.syssoft-int.com

 

[mac7attack]

I would have posted code in the first place, but I didnt want to overload the page. Well here is the code that runs slow.
All number variables are Integers.
Ask about any other variables and Ill answer

    'The following removes blank lines. Blank = no data in any cells
    'Works from the bottom to avoid deletion of valid data and conflicts
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        For i = Selection.Rows.Count To 1 Step -1
            If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
                Selection.Rows(i).EntireRow.Delete
            End If
        Next i
        .Calculation = xlCalculationAutomatic
    End With

    i = 0

    x = lastRow

    For x = lastRow To 3 Step -2
        Analyzed.Rows(x).Select
        Selection.Delete Shift:=xlUp
    Next x
    
    DataRows = DataRows + 1
    
    Rw = 1
    For Rw = 1 To DataRows Step 1
        CelLen = Len(Trim(Analyzed.Cells(Rw, "B")))
        Select Case CelLen
            Case 7 'Cell contains "Unknown"
                Analyzed.Cells(Rw, "C") = Analyzed.Cells(Rw, "B")
            Case 4 '4 digit internal dialing
                Analyzed.Cells(Rw, "C") = 919
                Analyzed.Cells(Rw, "D") = "4  Digits"
            Case 3 'Cell contain only area code, number is unknown
                Analyzed.Cells(Rw, "C") = Analyzed.Cells(Rw, "B").Value
                Analyzed.Cells(Rw, "D") = "Unknown"
            Case 12 'US/Canada Call
                Analyzed.Cells(Rw, "C") = Mid(Analyzed.Cells(Rw, "B"), 3, 3)
                Analyzed.Cells(Rw, "D") = "US/Canada"
            Case 10 'US/Canda Call, 81 was not reported
                Analyzed.Cells(Rw, "C") = Mid(Analyzed.Cells(Rw, "B"), 1, 3)
                Analyzed.Cells(Rw, "D") = "US/Canada"
            Case Is > 12 'International Call
                Analyzed.Cells(Rw, "C") = Mid(Analyzed.Cells(Rw, "B"), 2, 3)
                Analyzed.Cells(Rw, "D") = "International"
            Case Else
                Analyzed.Cells(Rw, "C") = "Unknown"
        End Select
    Next Rw
       
    Analyzed.Columns("B:B").EntireColumn.AutoFit
    Analyzed.Columns("C:C").EntireColumn.AutoFit
    Analyzed.Columns("D:D").EntireColumn.AutoFit
    Analyzed.Columns("A:D").Select
    Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Key2:=Range("D1") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, _
        DataOption2:=xlSortNormal
        
    Analyzed.Range("A1").Select
    
    GCount = 1
 
    For i = 1 To DataRows Step 1
        If (i = 1) Then
                Analyzed.Cells(GCount, "G") = 1
        Else
            If Analyzed.Cells(i, "C") <> Analyzed.Cells(i - 1, "C") Then
               Analyzed.Cells(GCount, "G") = 1
            End If
        End If
        
        If Analyzed.Cells(i, "C") = Analyzed.Cells(i + 1, "C") Then
            Analyzed.Cells(GCount, "G") = Analyzed.Cells(GCount, "G") + 1
            Analyzed.Cells(GCount, "F") = Analyzed.Cells(i, "C")
        Else
            If (Analyzed.Cells(i, "C") <> Analyzed.Cells(i + 1, "C")) And (Analyzed.Cells(i, "C") <> Analyzed.Cells(i - 1, "C")) Then
                Analyzed.Cells(GCount, "G") = 1
                Analyzed.Cells(GCount, "F") = Analyzed.Cells(i, "C")
            End If
            GCount = GCount + 1
        End If
    Next i
    Application.ScreenUpdating = True

 

[SkipVought]

Use the AutoFilter to criteria/select blank lines and then IN ONE STEP delete the Visible Cells using

SpecialCells(xlCellTypeVisible)

No LOOP required

Skip,

_{[red]A palindrome gone wrong?[/red]
A man, a plan, a ROOT canal...
PULLEMALL!}

 

[SkipVought]

Use Activate and Select methods SPARINGLY

With Analyzed
....
    For x = lastRow To 3 Step -2
        .Rows(x).Delete Shift:=xlUp
    Next x
....
End With

conbine ranges

....
    .columns("B:C").EntireColumn.AutoFit
....

Make better use of the With construct

Skip,

_{[red]A palindrome gone wrong?[/red]
A man, a plan, a ROOT canal...
PULLEMALL!}