0

I want to increase the efficiency of my macro by using If WorksheetFunction.CountA(Range("A1:D500")) = "NA" Then to clear contents if a cell in that range has "NA".

I need to store the current selection of my macro because values in sheets are stored in different locations.

I am using this code

Range("C6").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

For N = 3 To 15
Sheets(N).Activate
    Dim rng As Range
    For Each rng In Selection
        If IsError(rng) Then
        rng.ClearContents
        Else
        rng.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        End If
       Next rng
Next N

This loop looks in every cell for the current selection but I have 15 sheets in which to look for and erase every "NA" value so it takes too long.

Community
  • 1
  • 1
Maxwell
  • 109
  • 1
  • 13
  • Check out this post: http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros If you quit using .Select and then working with the Selection, your code will run dramatically faster. – Tim Aug 05 '15 at 15:33
  • I've checked but I want to know how to change it to this WorksheetFunction.CountA(Range("A1:D500")) = "NA" – Maxwell Aug 05 '15 at 16:15
  • CountA "Counts the number of cells in a range that are not empty". It will return a count of every cell that contains a value...be it NA or something else. You would use it by passing it your range object: rng or `WorksheetFunction.CountA(rng)` Adding the `= "NA"` on the end will make it a Boolean comparison which is always going to resolve to `FALSE`. I have no idea how to add `FALSE` to your code to make it faster. If you can point out where you would like to use `FALSE`, I can try to help. – Tim Aug 05 '15 at 16:32
  • Do you want to check if your ranges contain the string "NA" or the "#N/A" error returned by a function? – Mark Fitzgerald Aug 06 '15 at 00:54

1 Answers1

0

Sorry about not incorporating the CountA function but I'm fairly sure you will be happy with the vast improvement in "efficiency" with an approximately 555,000% speed increase! (calculated using time to execute your code against time to execute mine). It's a long read but hopefully worthwhile and educational.

If you feel the "need for speed" in your code, it's a good idea to use:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
    'your code here
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

in your procedures unless continuous calculation is required or you specifically want event procedures to run. If you're displaying message boxes or UserForms you may want to briefly allow ScreenUpdating.

To demonstrate this, I created a workbook with 18 identical sheets containing mostly values in A1:D500 plus 66 Vlookups evaluating to #N/A per sheet. I put your code in a procedure named DeleteErrorsUsingLoops(). I made sure C6:D500 was selected on each sheet and ran your code as it stands but with a timer added.

Sub DeleteErrorsUsingLoops()
Range("C6").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

Dim StartTime As Date
StartTime = Now()
Dim N As Long
For N = 3 To 15
Sheets(N).Activate
    Dim rng As Range
    For Each rng In Selection
        If IsError(rng) Then
        rng.ClearContents
        Else
        rng.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        End If
       Next rng
Next N
MsgBox Format(Now() - StartTime, "hh:mm:ss.000000")
End Sub

It took 11 minutes, 1 second to run on an i7-3820 quad core running at 3.6Ghz with 8GB RAM. I feel your pain!

Running it again with screen updating turned off, it took 39 seconds which is a 1,692% improvement.

Disabling calculation and events in this case made no difference because the cells being deleted have no dependents, so no recalculation required, and there are no event procedures in my workbook.

Use Loops sparingly

Sometimes you have to use loops to cycle through a Collection of books or sheets for example. That isn't usually a problem because the numbers are relatively small.

When you start looping through every cell in a range and perform several actions (select, evaluate, clear, copy, paste) takes time even if you aren't forced to watch it all happen.

Instead of looping through all 990 cells on 13 sheets you could use the equivalent of Find & Select...Go To...Special...Formulas...Errors (only) which would select all your "#N/A"'s if you did it on sheet. I recorded a macro doing just that:

Sub SelectErrors()
'
' SelectErrors Macro
'

'
    Selection.SpecialCells(xlCellTypeFormulas, 16).Select
End Sub

You could then clear the selection with Selection.ClearContents but I don't like using Selections, Select (unless it's followed by Case) or Activate. So instead of the recorded macro code I'd use something like:

[C6:D500].SpecialCells(xlCellTypeFormulas, xlErrors).ClearContents

Avoid Activate and Select

  • they cause a speed hit (i.e. slow things down)
  • can result in errors and unpredictable results. For example, in your code, if cell A1 is selected in all but your first sheet then only A1 is tested on those sheets. You may feel good when your procedure runs faster but it hasn't deleted the errors in sheets 4 to 15.

Use With...End With constructs instead These reduce repetition. You could write

Sheets(x).[C6:D500].SpecialCells(xlCellTypeFormulas, xlErrors).ClearContents
Sheets(x).[C6:D500].Copy
Sheets(x).[C6:D500].PasteSpecial xlPasteValues

Or you could take out the common expression Sheets(x).[C6:D500] and put in a With:

With Sheets(x).[C6:D500] 'define range you want to work on
    .SpecialCells(xlCellTypeFormulas, xlErrors).ClearContents
    .Copy
    .PasteSpecial xlPasteValues
End With

Note that each expression within the With...End With starts with a dot (.).

Put all of the above together to get the blindingly fast:

Sub FindAndDeleteErrors()
'Clears contents in cells returning errors while leaving formats
'within a defined range on all sheets within a workbook.
'Assumes no Chart sheets in workbook else use Worksheets collection.

Dim ErrorMsg As String 'just in case!
Dim ws As Worksheet
Dim StartTime
Dim x As Long 'arguably faster than Integer - Google it.
    On Error GoTo Ender:
    StartTime = MicroTimer 'An API function appended below.
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    For x = 3 To 15 'set up Sheet loop boundaries
        With Sheets(x).[C6:D500] 'define range you want to work on
            'test that there will be error cells to work on to avoid error
            On Error Resume Next 'will error in no xlErrors in range
            If Err > 0 Then
                ErrorMsg = "An " & Err.Number & " error (" & Error & ") occurred in sheet " & Sheets(x).Name
            End If
            .SpecialCells(xlCellTypeFormulas, xlErrors).ClearContents
            On Error GoTo Ender:
            .Copy
            .PasteSpecial xlPasteValues
            Application.CutCopyMode = False 'clear the clipboard
        End With
    Next x
    StartTime = MicroTimer - StartTime 'calculate elapsed time
    StartTime = Round(StartTime, 5) 'show it to 5 decimals
    MsgBox CDbl(StartTime)
Ender:     'runs On Error to restore normal operation
    If ErrorMsg <> "" Then 'display error
        MsgBox ErrorMsg, vbCritical
    End If
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

The MicroTimer function was copied from Office development > Office clients > Office 2010 > Excel 2010 > Technical Articles > Excel 2010 Performance: Improving Calculation Performance

Private Declare Function getFrequency Lib "kernel32" _
Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" _
Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Function MicroTimer() As Double
'

' Returns seconds.
    Dim cyTicks1 As Currency
    Static cyFrequency As Currency
    '
    MicroTimer = 0

' Get frequency.
    If cyFrequency = 0 Then getFrequency cyFrequency

' Get ticks.
    getTickCount cyTicks1

' Seconds
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function

Sorry about not incorporating the CountA function but I'm fairly sure you will be happy with the vast improvement in "efficiency"!!

Mark Fitzgerald
  • 3,048
  • 3
  • 24
  • 29