marku24
asked on
Filtering Excel Data in VBA
I have an excel sheet with multiple columns, the first two columns: Name and Date, has a long list of names and dates in many rows. I would like to run code that takes all unique dates for a particular name that i choose. So if i select BOB, i would want all unique dates for Bob in ascending order to be listed on another excel tab. Slight trick, the dates column has some non-date items listed under "BOB" that i do not want. So i really need the code to do 2 things; filter Bob information in column 2 and filter for only what is a date. Is that doable?
Yes, it is, but it would be most helpful if you could provide a sample spreadsheet showing the first tab with the two columns (only a few rows), and how you would like the second tab to look.
You can do this with AutoFilter or AdvancedFilter.
You can get the basic code by using the Macro Recorder. Such code will need editing. You can post the code with help to do that.
You can get the basic code by using the Macro Recorder. Such code will need editing. You can post the code with help to do that.
ASKER
sample file attached, notice I don't want the data of "Target" or "void"
Sorry ... don't see the file ...
ASKER
my fault
sample.xlsx
sample.xlsx
Try adding the following into a module on your worksheet (file also attached).
This assumes that your worksheet only has 1 tab with the users and dates.
Let me know if not the case.
This assumes that your worksheet only has 1 tab with the users and dates.
Let me know if not the case.
Option Explicit
Sub FindUserDates()
Dim lastRow As Integer
lastRow = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
Dim sht1idx As Integer
Dim sht1 As Worksheet
Dim sht2idx As Integer
Dim sht2 As Worksheet
Dim user As String
Set sht1 = ActiveSheet
user = InputBox("Who are you looking for?")
If user = "" Then End
For sht1idx = 2 To lastRow
Debug.Print Cells(sht1idx, 1)
If sht1.Cells(sht1idx, 1) = user And IsDate(sht1.Cells(sht1idx, 2)) Then
If ActiveWorkbook.Sheets.Count = 1 Then
Set sht2 = ActiveWorkbook.Sheets.Add(, ActiveSheet)
sht2.Columns("B:B").NumberFormat = "m/d/yyyy"
sht2.Name = user
sht2idx = 1
End If
sht2.Cells(sht2idx, 1) = user
sht2.Cells(sht2idx, 2) = sht1.Cells(sht1idx, 2)
sht2idx = sht2idx + 1
End If
Next
End Sub
SearchForUserDates.xlsm
Try this. Select any cell below the heading in column 'A'. Since you seemed to want sorting, I changed Nicholas' first date so that the sorting could be seen.
29136276.xlsm
29136276.xlsm
Oops ... missed the sorting part ... I'm sure Martin's code will work just fine, but just to fill out my code, you could add the following before the End Sub (updated file also attached):
sht2.Activate
sht2.Sort.SortFields.Clear
sht2.Sort.SortFields.Add2 Key:=Range("B:B"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With sht2.Sort
.SetRange Range("A:B")
.Orientation = xlTopToBottom
.Apply
End With
I have inserted a new sheet called "Filter" in the attached. You may rename it as per your need.
Right click on the Filter Tab --> View Code and place the codes given below into the opened code window and save your workbook as Macro-Enabled Workbook.
The drop down list in Cell B1 is being created by the macro dynamically so that if you add/delete the names in column A on Sheet1, the drop down list in B1 would be updated accordingly.
FilterData.xlsm
Right click on the Filter Tab --> View Code and place the codes given below into the opened code window and save your workbook as Macro-Enabled Workbook.
Private Sub Worksheet_Activate()
Dim wsdata As Worksheet
Dim x, dict
Dim i As Long
Set wsdata = Worksheets("Sheet1")
x = wsdata.Range("A1").CurrentRegion.Value
Set dict = CreateObject("Scripting.Dictionary")
On Error GoTo Skip
Application.EnableEvents = False
For i = 2 To UBound(x, 1)
dict.Item(x(i, 1)) = ""
Next i
If dict.Count Then
With Range("B1").Validation
.Delete
.Add xlValidateList, , , Formula1:=Join(dict.keys, ",")
End With
Else
Range("B1").Validation.Delete
End If
Skip:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim wsdata As Worksheet
Dim x, dict
Dim i As Long
Set wsdata = Worksheets("Sheet1")
x = wsdata.Range("A1").CurrentRegion.Value
Set dict = CreateObject("Scripting.Dictionary")
On Error GoTo Skip
If Target.Address(0, 0) = "B1" Then
Application.EnableEvents = False
Range("A3").CurrentRegion.Offset(1).Clear
If Target <> "" Then
For i = 2 To UBound(x, 1)
If x(i, 1) = Target And IsDate(x(i, 2)) Then
dict.Item(x(i, 2)) = ""
End If
Next i
If dict.Count Then
Range("B4").Resize(dict.Count) = Application.Transpose(dict.keys)
Range("A4").Resize(dict.Count) = Target
Range("A3").CurrentRegion.Sort key1:=Range("B4"), order1:=xlAscending, Header:=xlYes
End If
Range("A3").CurrentRegion.Borders.Color = vbBlack
End If
End If
Skip:
Application.EnableEvents = True
End Sub
In the attached, on Filter Sheet, if you select a Name from the drop down list in Cell B1, the relevant data would be populated below.The drop down list in Cell B1 is being created by the macro dynamically so that if you add/delete the names in column A on Sheet1, the drop down list in B1 would be updated accordingly.
FilterData.xlsm
ASKER
Thank you all. I am a little new to coding VBA in Excel. I used Martin's solution and modified it to work in my workbook. Works very well. My one issue is that I am not calling the routine by selecting a cell on that same page (although pretty cool), i am calling it from another tab unrelated to where the data resides. My data is on a tab call Data Collection, I am calling it from a tab called Setup Evaluations. I tried to take the code and put in a module as a function. It seems to not like me calling the function and says Object Required. Is this because i do not have a value for: (ByVal Target As Range). I changed the name of the function to PeopleDateSort and tried calling it by: Call PeopleDateSort
Do i need to seed it with a target parameter?
Do i need to seed it with a target parameter?
Please show me what the Setup Evaluations sheet looks like.
ASKER
It's just a menu page that has a command button to run the script. No important data or code. The data is on the data collection tab and it writes to a tab i renamed "workpapers". All of that works fine when i use your code from the data collection tab. I just want to trigger it from a menu page. I can change the value of the target value by having it reference a cell on a sheet. That works ok too. It's just calling the function in a module that is giving me a problem. Does that make sense?
Are you free to attach your actual workbook?
Also if the Setup Evaluations sheet has "No important data or code" I assume it doesn't have the employee names. If so how do you want to determine which employee to look at?
ASKER
good point. sorry i am dragging this on. I use a list box on the Setup Evaluations tab that write the person's name to cell D5. I use this and it works fine: Target = Sheets("Setup Evaluations").Range("D5"). So this would give me the value of "Nicholas" or "Bob", etc. I just can't call the code that i put in a module from the Setup Evaluations tab.
I would attach workbook but it has employee information.
I would attach workbook but it has employee information.
See if this works for you. I made it so that the Setup Evaluations sheet will always contain a dynamic list of the unique names on the Data Collection sheet. In other words changes to the names on the Data Collection sheet will be reflected in the Setup Evaluations sheet. Click any one of the names in the Setup Evaluations sheet to see the results for that employee.
29136276a.xlsm
29136276a.xlsm
I edited my comment in the above.
ASKER
Is there a way to have it reference the cell : Sheets("Setup Evaluations").Range("D5")? I have other unrelated information on the screen and every time I click on the screen the code triggers. I would like to tell the code when to execute, preferably with a command button. Apart from that the code works perfectly. Exactly what I wanted.
thank you for all your help
thank you for all your help
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Amazing. Thank you so much.
You’re welcome and I’m glad I was able to help.
If you expand the “Full Biography” section of my profile you’ll find links to some articles I’ve written that may interest you.
Marty - Microsoft MVP 2009 to 2017
Experts Exchange Most Valuable Expert (MVE) 2015, 2017
Experts Exchange Top Expert Visual Basic Classic 2012 to 2018
Experts Exchange Top Expert VBA 2018
If you expand the “Full Biography” section of my profile you’ll find links to some articles I’ve written that may interest you.
Marty - Microsoft MVP 2009 to 2017
Experts Exchange Most Valuable Expert (MVE) 2015, 2017
Experts Exchange Top Expert Visual Basic Classic 2012 to 2018
Experts Exchange Top Expert VBA 2018