View Full Version : Remove cell data for numbers over an average amount
MattehWoo
09-29-2016, 03:19 AM
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
09-29-2016, 04:28 AM
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)
> 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
09-29-2016, 05:30 AM
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
09-29-2016, 05:48 AM
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
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
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.