Question : Macro running very slow

Hi All
Im using Excel 07. The problem Im having is that a macro doing a fairly simple task takes forever. All it needs to do is the following find the column with the heading Rank and column Award. The Rank Column will contain blank values, 1,2,3, to n .The only thing the macro should do is find the Rank and Award columns . Then when there is a 1 value in Rank a Yes must be place on the same row under award. Ill attach the macro Im using
Thanks in advance
Elmo

Code Snippet:

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:

           
           
             Sub Reset2()
 
Dim lastr As Long
Dim lastc As Integer
Dim myRange As Range
Dim cell As Range
Dim Rcolumn As Integer
Dim Acolumn As Integer
Dim RAddress As String
Dim Aoffset As Integer
Dim Aaddress As String
 
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("RFQEvaluations").Activate
 
    lastr = Cells(65536, 1).End(xlUp).Row
    lastc = Cells(1, 255).End(xlToLeft).Column
    
    Set myRange = ActiveSheet.Range("A1", ActiveSheet.Cells(1, lastc))
    For Each cell In myRange
        
        Select Case cell.Value
            Case Is = "Award"
                Acolumn = cell.Column
                Aaddress = cell.Offset(1, 0).Address
            Case Is = "Rank"
                Rcolumn = cell.Column
                RAddress = cell.Offset(1, 0).Address
        End Select
    Next cell
    
    Aoffset = Acolumn - Rcolumn
    
    Set myRange = Nothing
   
    Set myRange = ActiveSheet.Range(RAddress, ActiveSheet.Cells(lastr, Rcolumn))
     
 
    For Each cell In myRange
        Select Case cell.Value
            Case Is = "1"
                cell.Offset(0, Aoffset).Value = "Yes"
            Case Else
                cell.Offset(0, Aoffset).Value = "No"
        End Select
    Next cell
    
    Set myRange = Nothing
        
        Sheets("Summary").PivotTables("PivotTable1").PivotCache.Refresh
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub

           
         

Open in New Window

Select All

Answer : Macro running very slow

I Just run this code...and it was quite fast...

Saurabh...

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:

           
           
             Option Explicit
 
Sub Reset2()
 
Dim lastr As Long
Dim lastc As Integer
Dim myRange As Range
Dim cell As Range
Dim Rcolumn As Integer
Dim Acolumn As Integer
Dim RAddress As String
Dim Aoffset As Integer
Dim Aaddress As String
 
 
 
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("Sheet1").Activate
 
    lastr = Cells(65536, 1).End(xlUp).Row
    lastc = Cells(1, 255).End(xlToLeft).Column
    
'=========================================
'Finds the two columns, Award and Rank
    
    
     Cells.Find(What:="Award", After:=Cells(1, 1), SearchDirection:=xlNext).Activate
     Acolumn = ActiveCell.Column
     
     Aaddress = ActiveCell.Offset(1, 0).Address
     Cells.Find(What:="Rank", After:=Cells(1, 1), SearchDirection:=xlNext).Activate
    Rcolumn = ActiveCell.Column
    RAddress = ActiveCell.Offset(1, 0).Address
    
    
'Gets the offset from rank to award
    Aoffset = Acolumn - Rcolumn
    
    Set myRange = Nothing
   
'Sets myRange to a new range -> the cells in the rank column
 
    Set myRange = ActiveSheet.Range(RAddress, ActiveSheet.Cells(lastr, Rcolumn)) 'Range AA2:AA225 in this sheet
'*******It is this for loop that takes so long
For Each cell In myRange
        Select Case cell.Value
            Case Is = "1"
                cell.Offset(0, Aoffset).Value = "Yes"
            Case Else
                cell.Offset(0, Aoffset).Value = "No"
        End Select
    Next cell
'**************************
    Set myRange = Nothing
        
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
           
         

Open in New Window

Select All