Wednesday, April 20, 2016

My stupid version of advanced filter macro,Sourav Bhattacharya,VBA Teacher




Private Sub Worksheet_Change(ByVal Target As Range)

   Dim KeyCells As Range

    Set KeyCells = Range("F2:G2")
   
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

     macro4
      
      
    End If
  
End Sub
 








Sub macro4()

database_clearfilter
clear_result

Workbooks("Macro_1.xlsm").Activate
    Sheets("DATABASE").Activate
ActiveSheet.Range("A2").Select
   
    Dim i As Long
    Dim count As Integer

    Dim str1 As String
    For i = 1 To 500000
    If ActiveCell.Value = "DOA(Month)" Then
    str1 = ActiveCell.Address
    Exit For
    Else
    ActiveCell.Offset(0, 1).Select
End If

   
   
   
   
   
    Next i
    MsgBox (str1)
   ActiveSheet.Range(str1).Select
    For i = 1 To 500000
    If ActiveCell.Value = "" Then
   
    Exit For
    Else
    str1 = ActiveCell.Address
   
   
    ActiveCell.Offset(1, 0).Select
End If

   
   
   
   
   
    Next i
   
 
   MsgBox (str1)
  
    Dim str2 As String
    str2 = "A2:" & str1
    MsgBox (str2)
    Sheets("DATABASE").Activate

    Range(str2).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("Dlr Filter_1st Macro").Range("F1:G2"), Unique:=False
   
    Range("A2").Select
   
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Dlr Filter_1st Macro").Select
   
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False

database_clearfilter

End Sub

Sub database_clearfilter()
Workbooks("Macro_1.xlsm").Activate
    Sheets("DATABASE").Activate

If ActiveSheet.AutoFilterMode Or ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
End If
End Sub

Sub clear_result()

Workbooks("Macro_1.xlsm").Activate
    Sheets("Dlr Filter_1st Macro").Activate
ActiveSheet.Range("A3").Select
   
    Dim i As Long
    Dim count As Integer

    Dim str1 As String
    For i = 1 To 500000
    If ActiveCell.Value = "DOA(Month)" Then
    str1 = ActiveCell.Address
    Exit For
    Else
    ActiveCell.Offset(0, 1).Select
End If

   
   
   
   
   
    Next i
    MsgBox (str1)
   ActiveSheet.Range(str1).Select
    For i = 1 To 500000
    If ActiveCell.Value = "" Then
   
    Exit For
    Else
    str1 = ActiveCell.Address
   
   
    ActiveCell.Offset(1, 0).Select
End If

   
   
   
   
   
    Next i
   
 
   MsgBox (str1)
  
    Dim str2 As String
    str2 = "A3:" & str1
    MsgBox (str2)
Range(str2).Clear


End Sub

No comments:

Post a Comment