PDA

View Full Version : Autofilter VBA



teodormircea
03-06-2008, 09:54 AM
Hello every one
I just found a very intersting code , this one , here on this forum, , great job


Dim Myrange As Range
Dim NumKill As Long
Dim KillColumn As String
Dim ActiveColumn As String
Dim AC

'Extract active column as text. Split needs Excel 200
AC = Split(ActiveCell.EntireColumn.Address(, False), ":")
ActiveColumn = AC(0)

KillColumn = InputBox("Enter Column that will be used to map rows for deletion - press Cancel to exit sub", "Row Delete Code", ActiveColumn)

'test that user has not used column IV
If Application.CountA(Range("IV:IV")) > 0 Then
MsgBox "There are no spare columns. Macro will exit", vbCritical
Exit Sub
End If

NumKill = InputBox("Input an Integer less than 65536", "How many rows do you want to kill", Default:=15)
'Run from row 1 of the selected column to the last used cell in that column

Set Myrange = Range(Cells(1, KillColumn), Cells(65536, KillColumn).End(xlUp))
Application.ScreenUpdating = False
If Myrange Is Nothing Then Exit Sub
With Myrange.Offset(0, 1)
.EntireColumn.Insert
.FormulaR1C1 = "=MOD(row(RC[-1])," & NumKill & ")=0"
.AutoFilter Field:=1, Criteria1:="FALSE"
If .Cells.Count > 0 Then .EntireRow.Delete
.EntireColumn.Delete
End With
Cells(1, KillColumn).Activate
Application.ScreenUpdating = True
End Sub
and i wouls like to modify it , in stead of chosing the number of rows to be kiled in the 2nd text box, i would like to make am autofilter , and to have in the second text box , the value that i wouls like to filter, ,count them , display the count in a textbox and have the possibility if i want or not to delete this rows.
If some one has a hint thanks

Bob Phillips
03-06-2008, 10:34 AM
Public Sub ProcessData()
Dim Myrange As Range
Dim CriteriaVal As Variant
Dim KillColumn As String
Dim ActiveColumn As String
Dim AC
Dim LastRow As Long
Dim rng As Range

AC = Split(ActiveCell.EntireColumn.Address(, False), ":")
ActiveColumn = AC(0)

KillColumn = InputBox("Enter Column that will be used to map rows for deletion - press Cancel to exit sub", "Row Delete Code", ActiveColumn)

If Application.CountA(Range("IV:IV")) > 0 Then
MsgBox "There are no spare columns. Macro will exit", vbCritical
Exit Sub
End If

CriteriaVal = InputBox("Supply a value to filter on", "Filter Criteria")

LastRow = Cells(Rows.Count, KillColumn).End(xlUp).Row
Set Myrange = Cells(1, KillColumn).Resize(LastRow)
Myrange.AutoFilter field:=1, Criteria1:=CriteriaVal
On Error Resume Next
Set rng = Cells(2, KillColumn).Resize(LastRow - 1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then

Application.ScreenUpdating = False
If MsgBox("There are " & rng.Cells.Count & " rows to delete. Delete them?", vbYesNo, "Shall we delete") = vbYes Then

rng.EntireRow.Delete
End If
Application.ScreenUpdating = True
End If
Myrange.AutoFilter
End Sub

teodormircea
03-06-2008, 11:12 AM
Is working great , nice job