Reputation: 81
I have some VBA code that filters some data, removes some columns and rows before totaling one column.
What I would like to achieve now is for a popup to appear before the totaling with a list of all items that exist in a certain column so that the user can select the ones they want and then remove the ones they don't want.
For example a column has a list of names, I would like a popup to give me the list of names (This could change each time so will need to get the list from the column) the user checks the ones they want then it removes all rows that contain the names they don't pick leaving the ones they do.
Name | Score |
---|---|
John | 1 |
Paul | 4 |
John | 1 |
Mark | 4 |
Paul | 6 |
Peter | 1 |
Mark | 7 |
This should give the user a popup with John, Paul Mark and Peter as choices.
If the user picks Paul and Peter, All rows containing Mark and John will be removed.
The code I am using to delete rows based on column contents is:
Public Sub del_Name()
Dim BarrToCheck As Variant
BarrToCheck = Array("Name.", "Paul", "John")
Dim q As Range 'create range
For Each q In ActiveSheet.UsedRange.Columns("A").Cells 'loop through range
If Len(q.Value) > 0 Then 'if value is more than 0 characters (not empty)
If Not BisInArray(q.Value, BarrToCheck) Then 'check if not in array
q.Value = "#N/A" 'make it #N/A
End If
End If
Next
Columns("A").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
End Sub
But I have no idea how to go about creating a popup to appear when the macro is ran to allow the user to choose which names to keep and which to put in the array for row deletion.
Any help or point in the right direction would be greatly appreciated.
Thanks
Upvotes: 1
Views: 149
Reputation: 6271
Create a Userform named Userform1
, and a ListBox named Listbox1
to your VBA project.
Use this code either append it to your Sub or use as a function with return value
of seled()
array which will contain the selected names of your table. Then you can use instead of BarrToCheck.
Sub selector()
Dim dropdown As MSForms.ListBox
Set dropdown = UserForm1.ListBox1
Set namerange = Range(ActiveSheet.Range("A1"), ActiveSheet.Range("A1").End(xlDown)) 'contains header row also
namearray = WorksheetFunction.Unique(namerange)
dropdown.List = namearray
dropdown.MultiSelect = fmMultiSelectMulti
UserForm1.Show
ReDim seled(dropdown.ListCount - 1)
j = 0
For i = 0 To dropdown.ListCount - 1
If dropdown.Selected(i) Then
seled(j) = dropdown.List(i)
j = j + 1
End If
Next i
If j = 0 Then MsgBox "No selection", vbCritical: Exit Sub Else ReDim Preserve seled(j - 1)
End Sub
Append the Sub into del_Name:
Public Sub del_Name()
'Copy the selector() sub content (w/o Sub and End Sub declarations.
'Finalize the selection with form window close button (top-right x)
Dim BarrToCheck As Variant
'BarrToCheck = Array("Name.", "Paul", "John") replace this line with
BarrToCheck = seled 'this
Dim q As Range 'create range
For Each q In ActiveSheet.UsedRange.Columns("A").Cells 'loop through range
If Len(q.Value) > 0 Then 'if value is more than 0 characters (not empty)
If Not BisInArray(q.Value, BarrToCheck) Then 'check if not in array
q.Value = "#N/A" 'make it #N/A
End If
End If
Next
Columns("A").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
End Sub
Upvotes: 1