VBA optimising code help...

zzjasonzz

Well-known Member
Joined
Apr 23, 2006
Messages
649
Hey,

I have a sheet that looks like:

Code:
    A      B              C           D         E        F          G        H           I         
1  ID  UserID  Firstname Surname Type  Score1 Score2 Score3 Score4
2   
3
.
.
.
.
## (could be anything)

There are two types of errors that can occur in the data that i need to find:
- If there is a duplicate UserID (column B) I need to put a 1 in Column M of all rows that are duplicate

- If any of the scores (columns F-I) are greater than 5 or less than 0 then its an error, also sometimes it will have #value in there. In both of these cases i need to put a 1 in column L and clear the particular score that is giving an error.

It works fine, but is really slow (obviously.. its pretty poorly written) for alot of rows. I don't mind doing a mixture of code/formula (i assume the duplicate one can be done by formula).

Code:
Sub check_errors()
Dim i
Sheets("Summary of Data").Activate
If Range("A3") = "" Then Exit Sub
If Range("A4") = "" Then Exit Sub
Application.ScreenUpdating = False
Range("M3:M10000").ClearContents
Rows("3:1000").Interior.ColorIndex = 0

For i = 3 To Range("A3").End(xlDown).Row
    Call check_dup(i)
    Call check_error(i)
Next i
Application.ScreenUpdating = True
Range("A3").Select

End Sub

Sub check_error(i)



    Range("L" & i) = ""
    
    If WorksheetFunction.IsError(Range("F" & i)) Then Range("F" & i) = "-1"
    If WorksheetFunction.IsError(Range("G" & i)) Then Range("G" & i) = "-1"
    If WorksheetFunction.IsError(Range("H" & i)) Then Range("H" & i) = "-1"
    If WorksheetFunction.IsError(Range("I" & i)) Then Range("I" & i) = "-1"
    
    If ((Range("F" & i).Value < 0) Or (Range("F" & i).Value > 5)) Then
        Range("F" & i).Formula = ""
        Range("L" & i) = 1
    End If
    
    If ((Range("G" & i).Value < 0) Or (Range("G" & i).Value > 5)) Then
        Range("G" & i).Formula = ""
        Range("L" & i) = 1
    End If
    
    If ((Range("H" & i).Value < 0) Or (Range("H" & i).Value > 5)) Then
        Range("H" & i).Formula = ""
        Range("L" & i) = 1
    End If

    If ((Range("I" & i).Value < 0) Or (Range("I" & i).Value > 5)) Then
        Range("I" & i).Formula = ""
        Range("L" & i) = 1
    End If
End Sub



Sub check_dup(i)
Dim j
Dim checkID

    checkID = Range("B" & i).Value
    Range("B" & i).Select
    For j = 3 To Range("A3").End(xlDown).Row
        'Range("M" & j) = ""
        'Range("M" & i) = ""
        If j <> i Then
            If checkID = Range("B" & j).Value Then
                    Range("M" & j) = 1
                    Range("M" & i) = 1
            End If
        End If
    Next j
End Sub

Thanks for reading!
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

tusharm

MrExcel MVP
Joined
May 28, 2002
Messages
11,029
Yes, using a formula and Advanced Filter (i.e., letting Excel do the heavy lifting) will be extremely fast.

In J2 enter the formula =COUNTIF($A$2:$A$20,A2)>1 where the first reference (A2:A20 in my test) refers to the entire range with data.

In K2 enter the *array* formula =OR(ISERROR(F2:I2))

In L2 enter the *array* formula =OR(F2:I2<0,F2:I2>5)

Now, filter on J being TRUE and delete all visible rows. Next, filter on K being TRUE and delete all visible rows. Finally, filter on L being TRUE and delete all visible rows. Alternatively, use Advanced Filter and find all rows where there is a TRUE in any of the J,K, or L columns and delete all visible rows.

If you must automate the above, turn on the macro recorder while doing the above. You should also check out
Beyond the macro recorder
http://www.tushar-mehta.com/excel/vba/beyond_the_macro_recorder/index.htm
 
Upvote 0

SydneyGeek

MrExcel MVP
Joined
Aug 5, 2003
Messages
12,251
As Tushar said, formulas and filtering will be much quicker.
The code below will write the formulas and convert them to values; you can then deal with the error rows by fitlering.

Code:
Sub check_errors_modified()
    Dim i As Long
    Dim Rw As Long
    Dim c As Range
    
    Sheets("Summary of Data").Activate
    If Range("A3") = "" Then Exit Sub
    If Range("A4") = "" Then Exit Sub
    Application.ScreenUpdating = False
    
    'find last row by riding up from bottom of sheet
    Rw = Cells(Rows.Count, 1).End(xlUp).Row
    
    Range("M3:M" & Rows.Count).ClearContents
    Rows("3:1000").Interior.ColorIndex = 0
    
    'convert errors to -1 values
    On Error Resume Next
    Range("F3:I" & Rw).SpecialCells(xlCellTypeFormulas, xlErrors).Value = -1
    On Error GoTo 0
    
    'write error list
    Range("L3").FormulaArray = "=IF(OR(RC[-6]:RC[-3]<0,RC[-6]:RC[-3]>5),1,0)"
    Range("L3").Copy
    Range("L4:L" & Rw).PasteSpecial
    Application.CutCopyMode = False
    
    'write duplicate list
    Range("M3:M" & Rw).FormulaR1C1 = "=IF(COUNTIF(C2,RC2)>1,1,0)"
    
    'convert to values
    Range("L3:M" & Rw).Select
    Selection = Selection.Value
    
    Range("A3").Select
    Application.ScreenUpdating = True
    
End Sub

Denis
 
Upvote 0

Forum statistics

Threads
1,190,765
Messages
5,982,810
Members
439,798
Latest member
tangojuliet

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top