asked on

Min Max Selection

The attached excel file (Excel 2010) contains groups of numbers. The goal is for the script to request a minimum number then a maximum number. Then to request me to select the source data. That would allow me to select beginning in row 8 down to the last row containing data.

The script would delete all rows below the minimum (the minimum would not be deleted) and also delete all rows above the maximum (the maximum would not be deleted). For example, if the min_number is 5 and the max_number is 30, any row containing 1-4 in the first column would be deleted (denoted in 'C') and any row containing 31 and up would be deleted (this is the number in 'C').

Since there is no '5' in this data the first row of data would be 6, 10, 11, 13, 14 (beginning at 44,234 in the excel file).

Finally, move the data up the to top, so I do not have to search as to where it is.
Min-Max-Selection.xlsx

Flyster

This code will apply a filter which will show all data between the minimum and maximum selected numbers.

Sub MinMaxFilter()
Dim mn, mx As Integer

mn = InputBox("Enter Minimum Number", "Selection-Minimum")
mx = InputBox("Select Maximum Number", "Selection-Maximum")

    ActiveSheet.Range("$C$8:$C$250000").AutoFilter Field:=1, Criteria1:=">=" & mn _
, Operator:=xlAnd, Criteria2:="<=" & mx

End Sub

Open in new window

Flyster

byundt

If you want to delete the rows rather than merely hide them, then consider the following macro:

Sub MinMaxFilter()
Dim mn As Long, mx As Long
Dim ar As Range, rg As Range, rgDel As Range

On Error Resume Next
mn = 1000000#   'In case user hits Cancel button, don't delete any data
mx = 1000000#   'In case user hits Cancel button, don't delete any data
mn = InputBox("Enter Minimum Number", "Selection-Minimum")
mx = InputBox("Select Maximum Number", "Selection-Maximum")
Set rg = Range("C7") 'Header label for column C. Data starts on row beneath this.
Set rg = Range(rg, Cells(Rows.Count, rg.Column).End(xlUp))
Set rgDel = rg.Offset(1, 0)
If (mx > mn) And (mx <> 1000000#) Then
    Application.ScreenUpdating = False
    rg.AutoFilter Field:=1, Criteria1:="<" & mn, Operator:=xlOr, Criteria2:=">" & mx
    Set rgDel = rgDel.SpecialCells(xlCellTypeVisible)
    For Each ar In rgDel.Areas
        ar.EntireRow.Delete
    Next
    ActiveSheet.UsedRange.AutoFilter
    mx = ActiveSheet.UsedRange.Rows.Count
End If
On Error GoTo 0
End Sub

Open in new window

Pedro

ASKER

Byundt,

Ran your code and found that it deletes one row too many. For instance, if the first number is 6 then the row containing 6, 10, 11, 13, 14 dissapears. I have to assume the same may applies to the last number. Also, I noticed that once it is done there are down arrows above the first row. Not sure if that is what obscures the numbers but please remove it and fix as needed.

Otherwise your code seems to work as planned.

Flyster,

Your code alters the excel numbers on the left column which not desired since I need excel to maintain its sequential numbering. Also row eight shows a row wich should not be there.

byundt

I believe the problem was lack of a header label in cell C7. I modified the code to put a header label in C7 if there wasn't one already. That header label is then cleared at the end of the macro.

Sub MinMaxFilter()
Dim mn As Long, mx As Long
Dim ar As Range, rg As Range, rgDel As Range

On Error Resume Next
mn = 1000000#   'In case user hits Cancel button, don't delete any data
mx = 1000000#   'In case user hits Cancel button, don't delete any data
mn = InputBox("Enter Minimum Number", "Selection-Minimum")
mx = InputBox("Select Maximum Number", "Selection-Maximum")
Set rg = Range("C7") 'Header label for column C. Data starts on row beneath this.
If rg.Value = "" Then rg.Value = "Header Label"
Set rg = Range(rg, Cells(Rows.Count, rg.Column).End(xlUp))
Set rgDel = rg.Offset(1, 0)
If (mx > mn) And (mx <> 1000000#) Then
    Application.ScreenUpdating = False
    rg.AutoFilter Field:=1, Criteria1:="<" & mn, Operator:=xlOr, Criteria2:=">" & mx
    Set rgDel = rgDel.SpecialCells(xlCellTypeVisible)
    For Each ar In rgDel.Areas
        ar.EntireRow.Delete
    Next
    rg.Cells(1, 1).AutoFilter
    If rg.Cells(1, 1).Value = "Header Label" Then rg.Cells(1, 1).Value = ""
    mx = ActiveSheet.UsedRange.Rows.Count
End If
On Error GoTo 0
End Sub

Open in new window

Pedro

ASKER

Byundt,

Good work so far. One las thing. It appears that it assumes the data is going to be in the same place all the time. However, it should ask me to select the source data. This is because the data may appear in different rows at times.

byundt

I added an Application.InputBox statement to let the user pick the top data cell.

Sub MinMaxFilter()
Dim mn As Long, mx As Long
Dim ar As Range, rg As Range, rgDel As Range

On Error Resume Next
mn = 1000000#   'In case user hits Cancel button, don't delete any data
mx = 1000000#   'In case user hits Cancel button, don't delete any data
mn = InputBox("Enter Minimum Number", "Selection-Minimum")
mx = InputBox("Select Maximum Number", "Selection-Maximum")
Set rg = Application.InputBox("Please pick first cell with data", "Experts Exchange Q28218842", Type:=8)
If rg Is Nothing Then Exit Sub

If rg.Row > 1 Then Set rg = rg.Offset(-1, 0) 'Header label cell
If rg.Value = "" Then rg.Value = "Header Label"
Set rg = Range(rg, Cells(Rows.Count, rg.Column).End(xlUp))
Set rgDel = rg.Offset(1, 0)
If (mx > mn) And (mx <> 1000000#) Then
    Application.ScreenUpdating = False
    rg.AutoFilter Field:=1, Criteria1:="<" & mn, Operator:=xlOr, Criteria2:=">" & mx
    Set rgDel = rgDel.SpecialCells(xlCellTypeVisible)
    For Each ar In rgDel.Areas
        ar.EntireRow.Delete
    Next
    rg.Cells(1, 1).AutoFilter
    If rg.Cells(1, 1).Value = "Header Label" Then rg.Cells(1, 1).Value = ""
    mx = ActiveSheet.UsedRange.Rows.Count
End If
On Error GoTo 0
End Sub

Open in new window

Pedro

ASKER

Something weird happens when I run the new code. See attached excel file row 7.

I chose C8:G8 and that was the result.

If I choose C8:G8 then press CTRL + Shift + down arrow to select all data then the data is replaced with 'header label' in all rows and column that contained data.

I would really prefer to choose all cells with data using ctrl, shift and down arrow without the numbers dissapearing. This way the script only runs on cells with data in it.
Min-Max-Selection.xlsm

ASKER CERTIFIED SOLUTION

byundt

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Pedro

ASKER

Job well Done!