View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
ra ra is offline
external usenet poster
 
Posts: 27
Default Delete Data in Range -macro

On Sep 20, 4:22 pm, JE McGimpsey wrote:
One way:

Const cdMaxPercent As Double = 1
Const csMsgColNum As String = _
"Column Number with Dates of interest (e.g., A=1)"
Const csMsgMin As String = _
"Minimum Value to be deleted (in %)"
Const csMsgMax As String = _
"Maximum Value to be deleted (in %)"
Const csTitle As String = "Delete Value Range"
Dim vResult As Variant
Dim rDelete As Range
Dim nCol As Long
Dim i As Long
Dim dMin As Double
Dim dMax As Double

Do
vResult = Application.InputBox( _
Prompt:=csMsgColNum, _
Title:=csTitle, _
Type:=1, _
Default:=1)
If vResult = False Then Exit Sub 'user cancelled
nCol = CLng(vResult)
Loop Until nCol 0 And nCol <= ActiveSheet.UsedRange.Columns.Count
Do
vResult = Application.InputBox( _
Prompt:=csMsgMin, _
Title:=csTitle, _
Type:=1, _
Default:=Format(0, "0.00%"))
If vResult = False Then Exit Sub 'user cancelled
dMin = CDbl(vResult)
Loop Until dMin = 0 And dMin < cdMaxPercent
Do
vResult = Application.InputBox( _
Prompt:=csMsgMax, _
Title:=csTitle, _
Type:=1, _
Default:=Format(cdMaxPercent, "0.00%"))
If vResult = False Then Exit Sub 'user cancelled
dMax = CDbl(vResult)
Loop Until dMax = dMin And dMax <= cdMaxPercent
For i = 2 To Cells(Rows.Count, nCol).End(xlUp).Row
With Cells(i, nCol)
If .Value = dMin And .Value <= dMax Then
If rDelete Is Nothing Then
Set rDelete = .Cells
Else
Set rDelete = Union(rDelete, .Cells)
End If
End If
End With
Next i
If Not rDelete Is Nothing Then rDelete.EntireRow.Delete

In article . com,



ra wrote:
Hello,


I want to delete data (entire row) within a certain range e.g. between
10% to 20%.


My first cut at it is below but seems to delete everything! any help
would be appreciated.


Dim StRange As Integer
Dim FinRange As Integer, LastRow&, i&
Dim ColumnNum As Integer
ColumnNum = InputBox("Column NUMBER with Dates of Interest (e.g.
A=1)")
StRange = InputBox("Values to be Deleted-ENTER Start Range %
(0.00)")
FinRange = InputBox("Values to be Deleted-ENTER End Range % (0.00)")
LastRow = Cells(Rows.Count, ColumnNum).End(xlUp).Row
For i = LastRow To 2 Step -1
If Cells(i, ColumnNum).Value = StRange And _
Cells(i, ColumnNum).Value <= FinRange Then
Rows(i).Delete
End If
Next i
End Sub- Hide quoted text -


- Show quoted text -


Thanks, that works like a charm! much appreciated