Home > front end >  Create a user form and extract certain data from the excel file via VBA
Create a user form and extract certain data from the excel file via VBA

Time:09-29

1. About data

Initially, in the user form, I have 2 check boxes. The first one is User_Type (that contains 3 check boxes 1, 2, 3) and the second one is User_Size (that contains 4 check boxes S,M,L,XL). The master data sheet contains 5 columns: Type, Size, Quantity, Price_per_unit, Total_price. The "Type" column includes 1,2,3 and "Size" column includes "S", "M", "L", "XL".

2. Expected output

How can I add to the below VBA code that works this way: If User_Type = Type and User_Size = Size, the relevant content of all 5 columns will be copied and pasted to another sheet?

3. Example

Type Size Quantity Price_per_unit Total_price
1 S 3 10 30
2 M 15 3 45
2 S 1 40 40
3 L 4 20 80
1 XL 7 5 35

For example, if I tick on the checkboxes 1 and 2 of User_Type and "S" of User_Size, the following information is supposed to be in another sheet:

Type Size Quantity Price_per_unit Total_price
1 S 3 10 30
2 S 1 40 40

Furthermore, I also get stuck in creating a user form containing the checkboxes

Private Sub CommandButton1_Click()
    UserInputForm.Show
End Sub

Private Sub UserForm ()
    'Fill TypeCheckBox
    With TypeListBox
        .AddItem "1"
        .AddItem "2"
        .AddItem "3"
    
    'Fill SizeCheckBox
    With SizeCheckBox
        .AddItem "S"
        .AddItem "M"
        .AddItem "L"
        .AddItem "XL"
    
    End With
End Sub

CodePudding user response:

You will need to add a command button in the UserForm and add this code on the click activity:

Private Sub CommandButton1_Click()
    Call filtering
    Unload Me
    
End Sub

Then, this module will help you with the filtering and pasting in a different worksheet.

Sub filtering()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastRow As Long
    Dim sizeFilter As String
    Dim typeFilter As String
    Dim lastColumn As Long
    Dim dataRange As Range
    Dim destinationRange As Range
    Dim typeColumnNumber As Long, sizeColumnNumber As Long

    Set ws1 = ThisWorkbook.Sheets("Sheet1") 'Update as needed
    Set ws2 = ThisWorkbook.Sheets("Sheet2") 'Update as needed
    Set destinationRange = ws2.Range("A1") 'Update as needed
    typeColumnNumber = 1 'Update as needed
    sizeColumnNumber = 2 'Update as needed
    
    typeFilter = UserInputForm.TypeListBox.Value
    sizeFilter = UserInputForm.SizeCheckBox.Value
    
    lastRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    lastColumn = ws1.Cells(2, ws1.Columns.Count).End(xlToLeft).Column
    
    Set dataRange = ws1.Range(ws1.Cells(1, 1), ws1.Cells(lastRow, lastColumn))
    
    'Clear filters
    If dataRange.AutoFilter Then dataRange.AutoFilter
    
    With dataRange
        .AutoFilter Field:=sizeColumnNumber, Criteria1:="=" & sizeFilter
        .AutoFilter Field:=typeColumnNumber, Criteria1:="=" & typeFilter
        .Copy
    End With
    
    destinationRange.PasteSpecial xlPasteValues
    
    'Clear filters
    dataRange.AutoFilter
    
End Sub

CodePudding user response:

So i started with following example list

enter image description here

and my userform looks like this

enter image description here

Code is not optimized so use at your own risk...

on change of the comboboxes the result list gets updated.

Private Sub ComboBox1_Change()
    Call clearResults

    Call filterEntries
End Sub

Private Sub ComboBox2_Change()
    Call clearResults

    Call filterEntries
End Sub

Private Sub UserForm_Initialize()
    With UserForm1.ComboBox1
        .AddItem "1"
        .AddItem "2"
        .AddItem "3"
    End With

    With UserForm1.ComboBox2
        .AddItem "S"
        .AddItem "M"
        .AddItem "L"
    End With
End Sub

Private Sub clearResults()
    Sheets("Sheet2").Activate
    Worksheets("Sheet2").Range("F3:G7").Clear
End Sub

Private Sub filterEntries()
    Dim listOfEntries()
    Dim numOfEntries As Integer
    Dim numOfColumns As Integer
    Dim x As Integer
    numOfColumns = 2

    numOfEntries = Worksheets("Sheet1").Range("B3", Worksheets("Sheet1").Range("B3").End(xlDown)).Rows.Count

    ReDim listOfEntries(numOfEntries, numOfColumns - 1)

    'get list of all entries
    Sheets("Sheet1").Activate
    Worksheets("Sheet1").Range("B3").Select
    For x = 1 To numOfEntries
        'get type into list
        listOfEntries(x - 1, 0) = CStr(ActiveCell)
        'get size into list
        listOfEntries(x - 1, 1) = ActiveCell.Offset(0, 1)
        
        ' Selects cell down 1 row from active cell to loop downwards
        ActiveCell.Offset(1, 0).Select
    Next


    'filter and paste results
    Sheets("Sheet2").Activate
    Worksheets("Sheet2").Range("F3").Select
    For x = 1 To numOfEntries
        If ComboBox1 = "" Or listOfEntries(x - 1, 0) = ComboBox1.Value Then
            If ComboBox2 = "" Or listOfEntries(x - 1, 1) = ComboBox2.Value Then
                Call pasteResult(x, listOfEntries)
            End If
        End If

        ' Selects cell down 1 row from active cell.
        If Not IsEmpty(ActiveCell) Then
            ActiveCell.Offset(1, 0).Select
        End If
    Next

End Sub

Private Sub pasteResult(x As Integer, list As Variant)
    ActiveCell = list(x - 1, 0)
    ActiveCell.Offset(0, 1) = list(x - 1, 1)
End Sub
  • Related