PDA

View Full Version : [SOLVED] Userform to simulate 2007 autofilter options



mperrah
12-09-2007, 09:44 PM
II'm trying to filter data based on 3 criteria using pre-2007 excel.
In 2007 that is easy with autofilter and check the 3 I want to keep.
In older versions only 1 or 2 items are allowed.

I would like to develop a userform that loads a multiselect check box list from the values in columns on the sheet.
The columns have a header row.
Tech name (Col H), Customer City (Col J), and Job Type (Col E)
It would be helpful to have a begin date and end date option, but I can pull the data into my sheet already within the dates needed. Job Date (Col M) - not sure how to pick first and lst date to include.

I found this code to load a comboBox in a form,
But not sure how to manipulate the data based on the chosen criteria

Need help to Populate 3 comboBoxes based on sheet (Col E, H, J, optional-M)
How to multiselect in comboBox (choose 1, some or all)
And to hide (or) delete none matching rows


Private Sub UserForm_Initialize()
Dim UniqueList() As String
Dim x As Long
Dim Rng1 As Range
Dim c As Range
Dim Unique As Boolean
Dim y As Long
With Worksheets("Raw")
iLastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
Set Rng1 = .Range("H1:H" & iLastRow)
End With
y = 1
ReDim UniqueList(1 To Rng1.Rows.Count)
For Each c In Rng1
If Not c.Value = vbNullString Then
Unique = True
For x = 1 To y
If UniqueList(x) = c.Text Then
Unique = False
End If
Next
If Unique Then
y = y + 1
Me.ObjectBox.AddItem (c.Text)
UniqueList(y) = c.Text
End If
End If
Next
End Sub
Thank you in advance...

Mark

Bob Phillips
12-10-2007, 03:09 AM
Populate the comboboxes


With Worksheets("DATA")
ComboBox1.List = .Range("E2").Resize(.Cells(.Rows.Count, "E").End(xlUp).Row - 1)
'etc.
End With

Multiselect


With Me.ComboBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
Msgbox .List(i)
End If
Next i
End With

mperrah
12-10-2007, 11:53 AM
Thank yo xld,
I probably did not build the form correctly (not much experience in forms)
but I modified the codes I had with yours and have the form loading the values ok.
How can I use the selections from the form to remove the the rows of non-selected items.
Goal is to have only items with all three matching remain, rest gets removed.
It would be great to filter the rows first, if the results are satisfactory, then prompt to delete.

I have another sub that copies data from this sheet to another,
the other sub wont run on filtered data.
So if the user is happy with the change,
delete what is not visible and de-activate filter



Private Sub UserForm_Initialize()
Dim UniqueList1() As String
Dim UniqueList2() As String
Dim UniqueList3() As String
Dim x As Long
Dim Rng1 As Range
Dim c As Range
Dim Unique As Boolean
Dim y As Long
Dim Rng2 As Range
Dim Rng3 As Range
With Worksheets("Raw")
iLastRow = .Cells(.Rows.Count, "AS").End(xlUp).Row - 1
Set Rng1 = .Range("AS2:AS" & iLastRow)
Set Rng2 = .Range("R2:R" & iLastRow)
Set Rng3 = .Range("F2:F" & iLastRow)
End With
y = 1
ReDim UniqueList1(1 To Rng1.Count)
For Each c In Rng1
If Not c.Value = vbNullString Then
Unique = True
For x = 1 To y
If UniqueList1(x) = c.Text Then
Unique = False
End If
Next
If Unique Then
y = y + 1
Me.List_Techs.AddItem (c.Text)
UniqueList1(y) = c.Text
End If
End If
Next
y = 1
ReDim UniqueList2(1 To Rng2.Count)
For Each c In Rng2
If Not c.Value = vbNullString Then
Unique = True
For x = 1 To y
If UniqueList2(x) = c.Text Then
Unique = False
End If
Next
If Unique Then
y = y + 1
Me.List_City.AddItem (c.Text)
UniqueList2(y) = c.Text
End If
End If
Next
y = 1
ReDim UniqueList3(1 To Rng3.Count)
For Each c In Rng3
If Not c.Value = vbNullString Then
Unique = True
For x = 1 To y
If UniqueList3(x) = c.Text Then
Unique = False
End If
Next
If Unique Then
y = y + 1
Me.List_Type.AddItem (c.Text)
UniqueList3(y) = c.Text
End If
End If
Next

mperrah
12-10-2007, 12:32 PM
testing for match in all three selected list items.
If found, hide, and prompt for deletion.
If yes delete hidden, if no, unhide...


Private Sub UserForm_Initialize()
Dim UniqueList1() As String
Dim UniqueList2() As String
Dim UniqueList3() As String
Dim xa As Long
Dim xb As Long
Dim xc As Long
Dim Rng1 As Range
Dim ca As Range
Dim cb As Range
Dim cc As Range
Dim Unique As Boolean
Dim ya As Long
Dim yb As Long
Dim yc As Long
Dim Rng2 As Range
Dim Rng3 As Range
Dim TestMatch As Long
With Worksheets("Raw")
iLastRow = .Cells(.Rows.Count, "AS").End(xlUp).Row - 1
Set Rng1 = .Range("AS2:AS" & iLastRow)
Set Rng2 = .Range("R2:R" & iLastRow)
Set Rng3 = .Range("F2:F" & iLastRow)
End With
ya = 1
ReDim UniqueList1(1 To Rng1.Count)
For Each ca In Rng1
If Not ca.Value = vbNullString Then
Unique = True
For xa = 1 To ya
If UniqueList1(xa) = ca.Text Then
Unique = False
End If
Next
If Unique Then
ya = ya + 1
Me.List_Techs.AddItem (ca.Text)
UniqueList1(ya) = ca.Text
End If
End If
Next
yb = 1
ReDim UniqueList2(1 To Rng2.Count)
For Each cb In Rng2
If Not cb.Value = vbNullString Then
Unique = True
For xb = 1 To yb
If UniqueList2(xb) = cb.Text Then
Unique = False
End If
Next
If Unique Then
yb = yb + 1
Me.List_City.AddItem (cb.Text)
UniqueList2(yb) = cb.Text
End If
End If
Next
yc = 1
ReDim UniqueList3(1 To Rng3.Count)
For Each cc In Rng3
If Not cc.Value = vbNullString Then
Unique = True
For xc = 1 To yc
If UniqueList3(xc) = cc.Text Then
Unique = False
End If
Next
If Unique Then
yc = yc + 1
Me.List_Type.AddItem (cc.Text)
UniqueList3(yc) = cc.Text
End If
End If
Next
End Sub

Private Sub CBtn_Filter_Click()
For TestMatch = 1 To iLastRow
If ca = ya And _
cb = yb And _
cc = yc Then
' leave rows
Else
ca.EntireRow.Hide
End If
Next TestMatch
testMatchAns = MsgBox("Are the results Okay?", vbYesNo, "Filter Results")
If testMatchAns = vbOK Then
With ActiveSheet
.Rows.Hidden.Delete
End With
ElseIf testMatchAns = vbNo Then
.rows.hidden.unhide
Exit Sub
End If
End Sub

Private Sub CBtn_X_Click()
UserForm1.Hide
End Sub

mperrah
12-10-2007, 12:45 PM
My code is not working,
not handling if multiple items in each list selected.
If 2 techs picked, match for other items should be relevant to the tech...
List items selected:
ca=joe and frank cb=Modesto, cc=NC
If ca=joe, cb=Modesto, cc=NC then row should stay. (3 match)
if ca=frank, cb=Modesto, cc=NC row should stay (3 Match)
if ca=tom, cb=Modesto, cc=NC entire row should hide, (1 mismatch)
if ca=joe, cb=Ceres, cc=RC entire row should hide... (2 mismatch)

mperrah
12-11-2007, 12:25 AM
found this to hide rows based on selected list items.
Works with function check...
worked once, tried to add a second item.. stopped working


Private Sub CBtn_Filter_Click()
Dim cell As Range
Dim a As Long, b As Long, c As Long, d As Long
With Me.List_Techs
For i = 0 To .ListCount - 1
If .Selected(i) Then
' MsgBox .List(i)
End If
Next i
End With
b = 2
For a = 2 To Range("AS2").End(xlDown).Row
If checkTechs(Range("AS" & a)) And a <> b Then
Rows(b & ":" & a - 1).Hidden = True
b = a + 1
End If
Next
If b <> a Then Rows(b & ":" & a).Hidden = True
' unload the dialog box
' With Me.List_City
' For i = 0 To .ListCount - 1
' If .Selected(i) Then
' MsgBox .List(i)
' End If
' Next I
' End With
' c = 2
' For d = 2 To Range("R2").End(xlDown).Row
' If checkCity(Range("R" & d)) And d <> c Then
' Rows(c & ":" & d - 1).Hidden = True
' c = d + 1
' End If
' Next
' If c <> d Then Rows(c & ":" & d).Hidden = True
' unload the dialog box
End Sub

Function checkTechs(a As Variant)
Dim b As Long
For b = 0 To UserForm1.List_Techs.ListCount - 1
If UserForm1.List_Techs.Selected(b) And UserForm1.List_Techs.List(b) = a Then
check = 1
Exit Function
End If
Next
check = 0
End Function

'Function checkCity(d As Variant)
' Dim c As Long
' For c = 0 To UserForm1.List_City.ListCount - 1
' If UserForm1.List_City.Selected(c) And UserForm1.List_City.List(c) = d Then
' check = 1
' Exit Function
' End If
' Next
' check = 0
'End Function

Still lost

rory
12-11-2007, 07:30 AM
Is it an option to use Advanced Filter? If you set up the criteria range ahead of time, your code can simply populate the required cells and apply the filter. You can also copy to a new location if required (I wasn't sure why your other code wouldn't work on filtered data)

mperrah
12-11-2007, 01:01 PM
I use 2007 and three or more autofilter options are easy.
older versions only allow up to 2.
Also, the skill level of the average user at this office are, well,
a little south of heaven.
I need to make it as simple and easy to use as possible.

I have a menu item that shows the userform,
the userform will show the tech name (Unique only and alpha sorted)
and the city (also unique and sorted alpha)
Optionaly I would like start and stop dates and job type,
but can live without them.
The user will click as many or as few techs, and cities,
then click sort/filter
The sheet will hide the options that don't match.
A msgBox will ask if they like the results,
if ok, delete hidden,
if no, unfilter and go back to userform.

figment
12-11-2007, 02:33 PM
try this


Private Sub UserForm_Initialize()
Dim UniqueList1() As String
Dim UniqueList2() As String
Dim UniqueList3() As String
Dim xa As Long
Dim xb As Long
Dim xc As Long
Dim Rng1 As Range
Dim ca As Range
Dim cb As Range
Dim cc As Range
Dim Unique As Boolean
Dim ya As Long
Dim yb As Long
Dim yc As Long
Dim Rng2 As Range
Dim Rng3 As Range
Dim TestMatch As Long
With Worksheets("Raw")
iLastRow = .Cells(.Rows.Count, "AS").End(xlUp).Row - 1
Set Rng1 = .Range("AS2:AS" & iLastRow)
Set Rng2 = .Range("R2:R" & iLastRow)
Set Rng3 = .Range("F2:F" & iLastRow)
End With
ya = 1
ReDim UniqueList1(1 To Rng1.Count + 1)
For Each ca In Rng1
If Not ca.Value = vbNullString Then
Unique = True
For xa = 1 To ya
If UniqueList1(xa) = ca.Text Then
Unique = False
End If
Next
If Unique Then
ya = ya + 1
Me.List_Techs.AddItem (ca.Text)
UniqueList1(ya) = ca.Text
End If
End If
Next
yb = 1
ReDim UniqueList2(1 To Rng2.Count + 1)
For Each cb In Rng2
If Not cb.Value = vbNullString Then
Unique = True
For xb = 1 To yb
If UniqueList2(xb) = cb.Text Then
Unique = False
End If
Next
If Unique Then
yb = yb + 1
Me.List_City.AddItem (cb.Text)
UniqueList2(yb) = cb.Text
End If
End If
Next
yc = 1
ReDim UniqueList3(1 To Rng3.Count + 1)
For Each cc In Rng3
If Not cc.Value = vbNullString Then
Unique = True
For xc = 1 To yc
If UniqueList3(xc) = cc.Text Then
Unique = False
End If
Next
If Unique Then
yc = yc + 1
Me.List_type.AddItem (cc.Text)
UniqueList3(yc) = cc.Text
End If
End If
Next
End Sub

Private Sub CBtn_Filter_Click()
Dim cell As Range
Dim a As Long, b As Long, c As Long, d As Long
Dim checked As Boolean
checked = False
For i = 0 To Me.List_Techs.ListCount - 1
If Me.List_Techs.Selected(i) Then checked = True
Next i
If Not checked Then
For i = 0 To Me.List_City.ListCount - 1
If Me.List_City.Selected(i) Then checked = True
Next
End If
If Not checked Then
For i = 0 To Me.List_type.ListCount - 1
If Me.List_City.Selected(i) Then checked = True
Next
End If
If checked Then
b = 2
For a = 2 To Range("AS2").End(xlDown).Row
If (checktechs(Range("AS" & a)) Or checkcity(Range("R" & a)) Or _
checktype(Range("F" & a))) And a <> b Then
Rows(b & ":" & a - 1).Hidden = True
b = a + 1
End If
Next
If b <> a Then Rows(b & ":" & a).Hidden = True
Else
End If
End Sub

Function checktechs(a As Variant)
Dim b As Long
For b = 0 To UserForm.List_Techs.ListCount - 1
If UserForm.List_Techs.Selected(b) And UserForm.List_Techs.list(b) = a Then
checktechs = True
Exit Function
End If
Next
checktechs = False
End Function

Function checkcity(a As Variant)
Dim b As Long
For b = 0 To UserForm.List_City.ListCount - 1
If UserForm.List_City.Selected(b) And UserForm.List_City.list(b) = a Then
checkcity = True
Exit Function
End If
Next
checkcity = False
End Function

Function checktype(a As Variant)
Dim b As Long
For b = 0 To UserForm.List_type.ListCount - 1
If UserForm.List_type.Selected(b) And UserForm.List_type.list(b) = a Then
checktype = True
Exit Function
End If
Next
checktype = False
End Function


Private Sub CBtn_X_Click()
UserForm.Hide
End Sub

when you working with a function that returns a value you have to set the function equal to something. when you changed the name of the function you didn't change the name of its return statment to match.

mperrah
12-11-2007, 09:50 PM
I changed the commands to UserForm1 (mine was named that)
Also I changed the Formula for type, the second line had City instaed of type.
The form doesn't load on initialize.
The form starts, but doesn't fill from the sheet?


Private Sub UserForm1_Initialize()
Dim UniqueList1() As String
Dim UniqueList2() As String
Dim UniqueList3() As String
Dim xa As Long
Dim xb As Long
Dim xc As Long
Dim Rng1 As Range
Dim ca As Range
Dim cb As Range
Dim cc As Range
Dim Unique As Boolean
Dim ya As Long
Dim yb As Long
Dim yc As Long
Dim Rng2 As Range
Dim Rng3 As Range
Dim TestMatch As Long
With Worksheets("Raw")
iLastRow = .Cells(.Rows.Count, "AS").End(xlUp).Row - 1
Set Rng1 = .Range("AS2:AS" & iLastRow)
Set Rng2 = .Range("R2:R" & iLastRow)
Set Rng3 = .Range("F2:F" & iLastRow)
End With
ya = 1
ReDim UniqueList1(1 To Rng1.Count + 1)
For Each ca In Rng1
If Not ca.Value = vbNullString Then
Unique = True
For xa = 1 To ya
If UniqueList1(xa) = ca.Text Then
Unique = False
End If
Next
If Unique Then
ya = ya + 1
Me.List_Techs.AddItem (ca.Text)
UniqueList1(ya) = ca.Text
End If
End If
Next
yb = 1
ReDim UniqueList2(1 To Rng2.Count + 1)
For Each cb In Rng2
If Not cb.Value = vbNullString Then
Unique = True
For xb = 1 To yb
If UniqueList2(xb) = cb.Text Then
Unique = False
End If
Next
If Unique Then
yb = yb + 1
Me.List_City.AddItem (cb.Text)
UniqueList2(yb) = cb.Text
End If
End If
Next
yc = 1
ReDim UniqueList3(1 To Rng3.Count + 1)
For Each cc In Rng3
If Not cc.Value = vbNullString Then
Unique = True
For xc = 1 To yc
If UniqueList3(xc) = cc.Text Then
Unique = False
End If
Next
If Unique Then
yc = yc + 1
Me.List_Type.AddItem (cc.Text)
UniqueList3(yc) = cc.Text
End If
End If
Next
End Sub

Private Sub CBtn_Filter_Click()
Dim cell As Range
Dim a As Long, b As Long, c As Long, d As Long
Dim checked As Boolean
checked = False
For i = 0 To Me.List_Techs.ListCount - 1
If Me.List_Techs.Selected(i) Then checked = True
Next i
If Not checked Then
For i = 0 To Me.List_City.ListCount - 1
If Me.List_City.Selected(i) Then checked = True
Next
End If
If Not checked Then
For i = 0 To Me.List_Type.ListCount - 1
If Me.List_Type.Selected(i) Then checked = True
Next
End If
If checked Then
b = 2
For a = 2 To Range("AS2").End(xlDown).Row
If (checktechs(Range("AS" & a)) Or checkcity(Range("R" & a)) Or _
checktype(Range("F" & a))) And a <> b Then
Rows(b & ":" & a - 1).Hidden = True
b = a + 1
End If
Next
If b <> a Then Rows(b & ":" & a).Hidden = True
Else
End If
End Sub


Function checktechs(a As Variant)
Dim b As Long
For b = 0 To UserForm1.List_Techs.ListCount - 1
If UserForm1.List_Techs.Selected(b) And UserForm1.List_Techs.List(b) = a Then
checktechs = True
Exit Function
End If
Next
checktechs = False
End Function

Function checkcity(a As Variant)
Dim b As Long
For b = 0 To UserForm1.List_City.ListCount - 1
If UserForm1.List_City.Selected(b) And UserForm1.List_City.List(b) = a Then
checkcity = True
Exit Function
End If
Next
checkcity = False
End Function

Function checktype(a As Variant)
Dim b As Long
For b = 0 To UserForm1.List_Type.ListCount - 1
If UserForm1.List_Type.Selected(b) And UserForm1.List_Type.List(b) = a Then
checktype = True
Exit Function
End If
Next
checktype = False
End Function


Private Sub CBtn_X_Click()
UserForm1.Hide
End Sub

figment
12-12-2007, 06:36 AM
i didn't do much with your data initalization code, so if your old code worked then what i did should still work. the code ran fine on the test workbook that i made, but then i made that workbook by looking at what the code did. if there is a discrepency between what the code is doing and where the data on you worksheet is, then you will need to give use an example of the worksheet.

mperrah
12-13-2007, 12:42 PM
Here is the file.
I copy the sheet the text was on from a larger workbook.
And copied the form(s)
I copied my old one, and made a new form with your code.
Mine loads the text, but filter hides all rows, not just matches.

Thank you for your persistence.

Mark

figment
12-13-2007, 04:23 PM
the problem was in you object names. the name of the objects on the form didn't match the names used in the code. here is the fix

7509

mperrah
12-14-2007, 12:01 AM
Thank you figment.
This works once, but if I unhide all the rows and try again,
every row is hidden. Or if I choose different options,
all rows get hidden (except header)
How do I clear the variables at the start of the filter sub?
Or is the function saving the true and false for the checked state?
On the command button click, how can I clear the function and/or selected option variables?

Mark

mperrah
12-14-2007, 01:24 PM
Figment, Thanks again,

I added an unhide all rows before the filter call. That helped.
the form can now filter rows based on the selected items.
I added multiselect to pick as many techs as I need, works great.
When I select a city, it adds all the techs that have a job in that city.
I'm trying for just techs selected, then jobs they did in the city selected.
then the jobs they did in that city of only the selected type.
How can I make a subfilter or secondary filter,
First filter (hide) rows based on tech selected
then with whats left, filter (hide) based on city selected,
Last with whats still visible, hide based on job type selected.

Can we use offset when techs match,
test if city matches and type matches in the same row,
if all three not match - hide row

Also, If a second tech is selected,
scan the city and type within that row for that tech - hide if not 3 matches

The tech is the main factor.
We want to check jobs by these guys,
and we want to be efficient in the areas we travel.

I'm not sure what coding to pursue...
Using offset in a match senario, or primary and secondary filter...
Thanks again, this is exciting, it's starting to come together :yes

mperrah
12-14-2007, 03:32 PM
This is skipping the last entry...
well it is hiding one more row than it should.
I've added 1's taken some out but can't see what I'm missing...

the ListTechs is a listbox in userform2.
I check one or more names and it hides the row with a match.
This is hidding an extra row on the bottom...
any ideas?

Private Sub CBtn_Filter_Click()
Dim cell As Range
Dim a As Long, b As Long
Dim checked As Boolean

checked = False
Rows.Hidden = False

With UserForm2
For i = 0 To .ListTechs.ListCount - 1
If .ListTechs.Selected(i) Then checked = True
Next i

If checked Then
b = 2
For a = 2 To Range("AS2").End(xlDown).Row
If (checktechs2(Range("AS" & a))) And _
a <> b Then
Rows(b & ":" & a - 1).Hidden = True
b = a + 1
End If
Next
If b <> a Then Rows(b & ":" & a).Hidden = True
Else
End If
End With
End Sub

figment
12-17-2007, 09:29 AM
give this a try


Private Sub CBtn_Filter_Click()
Dim cell As Range
Dim a As Long, b As Long
Dim checked As Boolean
checked = False
Rows.Hidden = False
With UserForm2
For i = 0 To .ListTechs.ListCount - 1
If .ListTechs.Selected(i) Then checked = True
Next i
If checked Then
b = 2
For a = 2 To Range("AS2").End(xlDown).Row + 1
If (checktechs2(Range("AS" & a))) And _
a <> b Then
Rows(b & ":" & a - 1).Hidden = True
b = a + 1
End If
Next
If b <> a Then Rows(b & ":" & a).Hidden = True
Else
End If
End With
End Sub

mperrah
12-17-2007, 12:36 PM
Thanks figment
This is still making some of the matched numbers hidden.
It doesn't seem to have a pattern.
I copied rows and sorted to see if it hides the first, last or middle.
It hides different rows.
Would the checkTechs work better with a number rather than a string?
Column C is a unique number associated to the tech name.
Filtering by that would work, if it helps?
:dunno

figment
12-17-2007, 02:25 PM
if the error appers to be random then i would guess that the mistake is in the input data and not the function. being that your working with a string, make sure that there are no leading or ending spaces, also check your functions to see if they are case sensitive. you can use the Ucase() and the Lcase() functions to force a string to be ither upper or lower case.

mperrah
12-17-2007, 07:22 PM
Not exactly.
The sub works the same each time for the selected item.
But not all instances of the selected item stay unhidden.

pick ken.zaas
there are 3 instances, only 2 stay unhidden

pick trevor.livingston
there is only one instance and one stays unhidden

pick pete.shumate
three instances, 2 stay unhidden.

every time these items are selected the same items are left unhidden,
but each time an instance gets hidden that shouldn't be....

I hand typed the items, copied and pasted ,
thinking like you, checking for differences in the cell data,
but making copies in different places...
still at least one item of a group gets hidden...
I tried using a number instead of the string, but no go either.

Not sure what I'm missing.

Thanks for your continued support

mperrah
12-17-2007, 07:25 PM
would option base 1
make a difference if I add it?
I know the code would need altering, just grasping at straws here

mperrah
05-24-2012, 10:52 AM
This file parses data and moves results to new sheet.
fills a cell with a check on click or arrow in to cell.
uses sumproduct on pie chart to show dynamic data.
It has an autokey swap for changing a "1" to a "p" (not numpad keys)
checks for macro enabled on load.
files data into specific cells of a form and makes a duplicate based on selected source data.
Quite an amazing work on the efforts of vbaexpress
Thanks to xld, aussiebear girlau and several others.

I've attached here for anyone interested.
The modules have a lot of work in it. Too much to explain.
Enjoy
Mark

mperrah
05-24-2012, 10:54 AM
attachment