Snasui Excel Forum

Code: Select all

Private Sub UserForm_Activate()
    lstWidth.RowSource = "WidthQry"
End Sub

Private Sub lstWidth_Click()
    Sheets("DataQuery").Select
    Range("B1:B109").Select
    Selection.ClearContents
    
    Sheets("Data").Select
    total_row = ActiveSheet.UsedRange.Rows.Count
    'Row count
        
    Sheets("Qry").Select
    Range("A3:G700").Select
    Selection.Delete
         
    j = 3
    For i = 2 To total_row
        If (Sheets("Data").Cells(i, 5) >= lstWidth.Value - 1 And Sheets("Data").Cells(i, 5) <= lstWidth.Value) Then
            Sheets("Qry").Cells(j, 1) = Sheets("Data").Cells(i, 1)
            Sheets("Qry").Cells(j, 2) = Sheets("Data").Cells(i, 2)
            Sheets("Qry").Cells(j, 3) = Sheets("Data").Cells(i, 3)
            Sheets("Qry").Cells(j, 4) = Sheets("Data").Cells(i, 4)
            Sheets("Qry").Cells(j, 5) = Sheets("Data").Cells(i, 5)
            Sheets("Qry").Cells(j, 6) = Sheets("Data").Cells(i, 6)
            Sheets("Qry").Cells(j, 7) = Sheets("Data").Cells(i, 7)
            j = j + 1
        End If
    Next
    txtWidth.Text = j - 3
        
    Range("F3:F4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("DataQuery").Select
    Range("B1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$B$1:$B$1336").RemoveDuplicates Columns:=1, Header:=xlNo
               
    Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("DataQuery").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DataQuery").Sort.SortFields.Add Key:=Range("B1"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("DataQuery").Sort
        .SetRange Range(Selection, Selection.End(xlDown))
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Sheets("Qry").Select
       
    lstLong.RowSource = "LongQry"
             
End Sub

Private Sub lstLong_Click()
    
    Sheets("DataQuery").Select
    Range("C1:C109").Select
    Selection.ClearContents
    
    Sheets("Data").Select
    total_row1 = ActiveSheet.UsedRange.Rows.Count
    
    Sheets("Qry").Select
    Range("A3:G700").Select
    Selection.Delete
    
     m = 3
        For i = 2 To total_row1
            If (Sheets("Data").Cells(i, 5) >= lstWidth.Value - 1 And Sheets("Data").Cells(i, 5) <= lstWidth.Value And Sheets("Data").Cells(i, 6) >= lstLong.Value - 1 And Sheets("Data").Cells(i, 6) <= lstLong.Value) Then
                Sheets("Qry").Cells(m, 1) = Sheets("Data").Cells(i, 1)
                Sheets("Qry").Cells(m, 2) = Sheets("Data").Cells(i, 2)
                Sheets("Qry").Cells(m, 3) = Sheets("Data").Cells(i, 3)
                Sheets("Qry").Cells(m, 4) = Sheets("Data").Cells(i, 4)
                Sheets("Qry").Cells(m, 5) = Sheets("Data").Cells(i, 5)
                Sheets("Qry").Cells(m, 6) = Sheets("Data").Cells(i, 6)
                Sheets("Qry").Cells(m, 7) = Sheets("Data").Cells(i, 7)
            m = m + 1
        End If
    Next
    txtLong.Text = m - 3
    
    'Sheets("Qry1").Select
   Range("G3:G4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("DataQuery").Select
    Range("C1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$C$1:$C$1336").RemoveDuplicates Columns:=1, Header:=xlNo
    
    Range("C1").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("DataQuery").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DataQuery").Sort.SortFields.Add Key:=Range("C1"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("DataQuery").Sort
        .SetRange Range(Selection, Selection.End(xlDown))
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Sheets("Qry").Select
    
    lstHeight.RowSource = "HeightQry"
    
End Sub

Private Sub lstHeight_Click()

    Sheets("Data").Select
    total_row2 = ActiveSheet.UsedRange.Rows.Count
    
    Sheets("Qry").Select
    Range("A3:G700").Select
    Selection.Delete
    
     n = 3
        For i = 2 To total_row2
            If (Sheets("Data").Cells(i, 5) >= lstWidth.Value - 1 And Sheets("Data").Cells(i, 5) <= lstWidth.Value And Sheets("Data").Cells(i, 6) >= lstLong.Value - 1 And Sheets("Data").Cells(i, 6) <= lstLong.Value And Sheets("Data").Cells(i, 7) >= lstHeight.Value - 2 And Sheets("Data").Cells(i, 7) <= lstHeight.Value) Then
                Sheets("Qry").Cells(n, 1) = Sheets("Data").Cells(i, 1)
                Sheets("Qry").Cells(n, 2) = Sheets("Data").Cells(i, 2)
                Sheets("Qry").Cells(n, 3) = Sheets("Data").Cells(i, 3)
                Sheets("Qry").Cells(n, 4) = Sheets("Data").Cells(i, 4)
                Sheets("Qry").Cells(n, 5) = Sheets("Data").Cells(i, 5)
                Sheets("Qry").Cells(n, 6) = Sheets("Data").Cells(i, 6)
                Sheets("Qry").Cells(n, 7) = Sheets("Data").Cells(i, 7)
            n = n + 1
        End If
    Next
   txtHeight.Text = n - 3
 
   
    Sheets("Qry").Select
    
End Sub

Private Sub btnClose_Click()
    Unload Me
End Sub