1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149
   | Private Sub CommandButton1_Click()
Dim strOperator1 As String, strOperator2 As String
Dim rCell As Range
 
    With Sheet2
             On Error Resume Next
 
            .Range("CriteriaData").ClearContents
            .Range("Z1:AD100").Clear
 
 
            If Dand.Value = True Then
                If D1.ListIndex > -1 Then .Range("B4") = "=" & """" & D1.Value & """"
                If D2.ListIndex > -1 Then .Range("C4") = "=" & """" & D2.Value & """"
            Else
                If D1.ListIndex > -1 Then .Range("B4") = "=" & """" & D1.Value & """"
                If D2.ListIndex > -1 Then .Range("B5") = "=" & """" & D2.Value & """"
            End If
 
            If Qand.Value = True Then
                If Q1.ListIndex > -1 Then .Range("D4") = Q1C & Q1.Value
                If Q2.ListIndex > -1 Then .Range("E4") = Q2C & Q2.Value
            Else
               If Q1.ListIndex > -1 Then .Range("D4") = Q1C & Q1.Value
               If Q2.ListIndex > -1 Then .Range("D5") = Q2C & Q2.Value
            End If
 
                strOperator1 = UBDC1
                strOperator2 = UBDC2
                If strOperator1 = "=" Then strOperator1 = ""
                If strOperator2 = "=" Then strOperator2 = ""
 
            If UBDand.Value = True Then
                If IsDate(UBD1) Then .Range("F4") = strOperator1 & UBD1.Value
                If IsDate(UBD2) Then .Range("G4") = strOperator2 & UBD2.Value
            Else
                If IsDate(UBD1) Then .Range("F4") = strOperator1 & UBD1.Value
                If IsDate(UBD2) Then .Range("F5") = strOperator2 & UBD2.Value
            End If
 
            If Land.Value = True Then
                If L1.ListIndex > -1 Then .Range("H4") = "=" & """" & L1.Value & """"
                If L2.ListIndex > -1 Then .Range("I4") = "=" & """" & L2.Value & """"
            Else
                If L1.ListIndex > -1 Then .Range("H4") = "=" & """" & L1.Value & """"
                If L2.ListIndex > -1 Then .Range("H5") = "=" & """" & L2.Value & """"
            End If
 
            If ACand.Value = True Then
               If AC1.ListIndex > -1 Then .Range("J4") = "=" & """" & AC1.Value & """"
               If AC2.ListIndex > -1 Then .Range("K4") = "=" & """" & AC2.Value & """"
            Else
               If AC1.ListIndex > -1 Then .Range("J4") = "=" & """" & AC1.Value & """"
               If AC2.ListIndex > -1 Then .Range("J5") = "=" & """" & AC2.Value & """"
            End If
 
           If WorksheetFunction.CountA(Range("FisrtRowCriteria")) > 0 Then
 
                        For Each rCell In Range("SecondRowCriteria")
                            If IsEmpty(rCell) And rCell.Offset(-1, 0) <> "" Then
                              rCell = rCell.Offset(-1, 0)
                            End If
                        Next rCell
 
 
                        If WorksheetFunction.CountA(Range("SecondRowCriteria")) > 0 Then
                                .Range(.Range("A4").End(xlToRight).Offset(-1, 0), _
                                .Range("L5").End(xlToLeft)).Name = "FilterCriteria"
                        Else
                                .Range(.Range("A4").End(xlToRight).Offset(-1, 0), _
                                .Range("L4").End(xlToLeft)).Name = "FilterCriteria"
                        End If
 
                             Range("Data_Table_With_Heads").AdvancedFilter _
                    Action:=xlFilterCopy, CriteriaRange:=Range("FilterCriteria"), CopyToRange:=.Range("Z1")
 
                    .Range("Z1").CurrentRegion.Offset(1, 0).Name = "Filtered_Data"
                    ListBox2.RowSource = ""
                    ListBox2.RowSource = "Filtered_Data"
            End If
    End With
 
    On Error GoTo 0
End Sub
 
Private Sub CommandButton2_Click()
UserForm_Initialize
End Sub
 
 
Private Sub D1_Change()
 
End Sub
 
Private Sub UBD1_Change()
    If UBD1.ListIndex > -1 Then
       UBD1 = Format(UBD1, "d-mmm-yy")
    End If
End Sub
Private Sub UBD2_Change()
    If UBD2.ListIndex > -1 Then
       UBD2 = Format(UBD2, "d-mmm-yy")
    End If
End Sub
 
Private Sub UserForm_Initialize()
Me.Height = 503
 
    With Sheet1
       Sheet2.Range("O1:AF100").ClearContents
 
       .Range("A1", .Range("A65536").End(xlUp)).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:="", CopyToRange:=Sheet2.Range("O1"), Unique:=True
        Sheet2.Range("O1").CurrentRegion.Offset(1, 0).Name = "DescriptionList"
        Range("DescriptionList").Sort Key1:=Range("DescriptionList").Cells(1, 1), Order1:=xlAscending, Header:=xlNo
        D1.RowSource = "DescriptionList"
        D2.RowSource = "DescriptionList"
       .Range("B1", .Range("B65536").End(xlUp)).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:="", CopyToRange:=Sheet2.Range("Q1"), Unique:=True
        Sheet2.Range("Q1").CurrentRegion.Offset(1, 0).Name = "QuantityList"
        Range("QuantityList").Sort Key1:=Range("QuantityList").Cells(1, 1), Order1:=xlAscending, Header:=xlNo
        Q1.RowSource = "QuantityList"
        Q2.RowSource = "QuantityList"
 
       .Range("C1", .Range("C65536").End(xlUp)).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:="", CopyToRange:=Sheet2.Range("S1"), Unique:=True
        Sheet2.Range("S1").CurrentRegion.Offset(1, 0).Name = "UBDList"
        Range("UBDList").Sort Key1:=Range("UBDList").Cells(1, 1), Order1:=xlAscending, Header:=xlNo
        UBD1.RowSource = "UBDList"
        UBD2.RowSource = "UBDList"
 
       .Range("D1", .Range("D65536").End(xlUp)).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:="", CopyToRange:=Sheet2.Range("U1"), Unique:=True
        Sheet2.Range("U1").CurrentRegion.Offset(1, 0).Name = "LocationList"
        Range("LocationList").Sort Key1:=Range("LocationList").Cells(1, 1), Order1:=xlAscending, Header:=xlNo
        L1.RowSource = "LocationList"
        L2.RowSource = "LocationList"
 
 
       .Range("E1", .Range("E65536").End(xlUp)).AdvancedFilter _
        Action:=xlFilterCopy, CriteriaRange:="", CopyToRange:=Sheet2.Range("W1"), Unique:=True
        Sheet2.Range("W1").CurrentRegion.Offset(1, 0).Name = "ACList"
        Range("ACList").Sort Key1:=Range("ACList").Cells(1, 1), Order1:=xlAscending, Header:=xlYes
        AC1.RowSource = "ACList"
        AC2.RowSource = "ACList"
 
    End With
 
End Sub |