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