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
and my userform looks like this
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