Remove cell data for numbers over an average amount

[MattehWoo]

Hi,

I have the following code but can't seem to get it to work.

I'm attempting to get the code to find a cell within the range that is over 10 times the average and to leave it blank.

Can anyone help?

Sub deletedata1()
Sheets("Reads").Select
range("D2").Select
colno = ActiveCell.Column

Dim myrange As range


With ActiveSheet
lastrow = .Cells(.Rows.Count, colno).End(xlUp).Row
myrange = range("D2:D & lastrow").Select
Avg = Application.WorksheetFunction.Average(myrange) * 10

For i = 1 To lastrow
If IsNumeric(Cells(i, colno)) Then
If Cells(i, colno) > Avg Then
Cells(i, colno) = ""
End If
End If
Next i
End With


End Sub

[offthelip]

I recognise this code!!!
You are not setting the range correctly here is an example of how to use the worksheet function in VBa with a specified range correctly:



Dim myrange As Range
Set myrange = Range(Cells(1, 1), Cells(10, 1))


ave = Application.WorksheetFunction.Average(myrange)

[mana]

> myrange = range("D2 & lastrow").Select


Set myrange = .Range("D2:D" & lastrow)







Option Explicit

Sub deletedata1()
Dim lastrow As Long
Dim myrange As Range
Dim colno As Long
Dim Avg As Double
Dim i As Long

colno = 4

With Sheets("Reads")
lastrow = .Cells(.Rows.Count, colno).End(xlUp).Row
Set myrange = .Range("D2:D" & lastrow)
Avg = WorksheetFunction.Average(myrange) * 10

For i = 1 To lastrow
If IsNumeric(.Cells(i, colno)) Then
If .Cells(i, colno) > Avg Then
.Cells(i, colno) = ""
End If
End If
Next i
End With

End Sub

[MattehWoo]

Offthelip - indeed - you've got me started on sorting out a mess hahaha! many thanks.

I've now added a part to only run the code if there's any data there.

I hope it makes sense?



Option Explicit

Sub deletedata2()


Dim lastrow As Long
Dim myrange As Range
Dim colno As Long
Dim Avg As Double
Dim i As Long

If WorksheetFunction.CountA(Range("H2:H5")) <> 0 Then

colno = 9

With Sheets("Reads")
lastrow = .Cells(.Rows.Count, colno).End(xlUp).Row
Set myrange = .Range("I2:I" & lastrow)
Avg = WorksheetFunction.Average(myrange) * 10

For i = 1 To lastrow
If IsNumeric(.Cells(i, colno)) Then
If .Cells(i, colno) > Avg Then
.Cells(i, colno) = ""
End If
End If
Next i
End With

End If

End Sub

[MattehWoo]

I've now updated it so that it will find any errors in the formula and remove them so that the rest will work:


Option Explicit
Sub deletedata2()


Dim lastrow As Long
Dim myrange As Range
Dim colno As Long
Dim Avg As Double
Dim i As Long

If WorksheetFunction.CountA(Range("H2:H5")) <> 0 Then

colno = 9

With Sheets("Reads")
lastrow = .Cells(.Rows.Count, colno).End(xlUp).Row
Set myrange = .Range("I2:I" & lastrow)
For i = 1 To lastrow
If IsError(.Cells(i, colno)) Then
.Cells(i, colno) = ""
End If
Next i
End With

With Sheets("Reads")
lastrow = .Cells(.Rows.Count, colno).End(xlUp).Row
Set myrange = .Range("I2:I" & lastrow)
Avg = WorksheetFunction.Average(myrange) * 10

For i = 1 To lastrow
If IsNumeric(.Cells(i, colno)) Then
If .Cells(i, colno) > Avg Then
.Cells(i, colno) = ""
End If
End If
Next i
End With

End If

End Sub

[mana]

columns("I") is formula?
please try this, you can get the same results.



Option Explicit

Sub test()
Dim r As Range
Dim c As Range
Dim Avg As Double
Dim colno As Long

colno = 9
If WorksheetFunction.CountA(Range("H2:H5")) = 0 Then Exit Sub

On Error Resume Next
Set r = Sheets("Reads").Columns(colno).SpecialCells(xlCellTypeFormulas, 1)
On Error GoTo 0

If r Is Nothing Then Exit Sub

Avg = WorksheetFunction.Average(r) * 10
For Each c In r
If c.Value > Avg Then c.Value = ""
Next

End Sub

[mana]

In your code, some lines are unnecessary.


Option Explicit


Sub deletedata2()

Dim lastrow As Long
Dim myrange As Range
Dim colno As Long
Dim Avg As Double
Dim i As Long

If WorksheetFunction.CountA(Range("H2:H5")) <> 0 Then

colno = 9

With Sheets("Reads")
lastrow = .Cells(.Rows.Count, colno).End(xlUp).Row
For i = 2 To lastrow
If IsError(.Cells(i, colno)) Then
.Cells(i, colno) = ""
End If
Next i


lastrow = .Cells(.Rows.Count, colno).End(xlUp).Row
Set myrange = .Range("I2:I" & lastrow)
Avg = WorksheetFunction.Average(myrange) * 10

For i = 2 To lastrow
If IsNumeric(.Cells(i, colno)) Then
If .Cells(i, colno) > Avg Then
.Cells(i, colno) = ""
End If
End If
Next i
End With

End If

End Sub