Create Dynamic Validation List & Then Pull Related Data into Sheet

Hello Excel Gurus.

I've spent a couple days searching MANY forums for a solution to 2 tasks i'm trying to complete with No Luck
to what i'm looking to accomplish.

I have a Sample WB to reference.
SampleWB.xlsm

OK, First I'd like to see if i can Create a Drop Down list on the "Today" sheet in "A1"
that is Dynamically Populated with all the Dates found on the "Data" sheet. This data is the final, cleaned up
version of data pasted in there after a macro runs to get it looking the way is does in the sample. The amount of columns
will remain the same after every clean up but the # of rows can be variable along with the potential amount of names and which
rows the dates fall on.

Second, the end goal is to be able to select a date from the drop down list and then create a list of people working that day
and their shifts. Anyone who is Off or has a value other than a time listed would default to Off.


I always try to self serve before posting as i'm trying to learn on my own but obviously need some help with
this. I respect all your input and Thank You All in advance for any and all replies and pointers.



Thanks
Scott

i don't think it's possible to have a data validation list populate from nonconsecutive cells like that... my first suggestion would be to loop through your data looking for "EMP Name" and then pulling the dates from that row into another range (probably on a new sheet or something). from there it's pretty easy - could do a variable named range for your data validation list using index() or offset(), or could just include that in the code that ran through the loop in the first place...

but, since you mention a previous macro which puts it in the current format I have to wonder - can we not change that format? it generally makes everything more difficult to arrange data in a way in which headers appear on multiple rows... what if all your dates were in column A, and your employee names were in row 1? that would make it much easier to create your data validation list...

this code transposes all your data from "Data" into a new tab called "New Data" and then pulls the dates listed into a validation list in A1 of the tab Today.

Sub transpose_data()
Dim output As Worksheet
Dim inpt As Worksheet
Dim rng As Range
Dim lr As Long
Dim nlr As Long
Dim daterng As Long
Dim lc As Long
Dim nc As Long
Dim nr As Long
Dim searchdte As Date
Dim form_strng As String

On Error Resume Next
Set output = Sheets("New Data")
    If output Is Nothing Then
    Sheets.Add(, Sheets(Sheets.Count)).Name = "New Data"
Set output = Sheets("New Data")
    End If

Set inpt = Sheets("Data")
lr = inpt.Range("A" & Rows.Count).End(3).Row
output.UsedRange.ClearContents
output.Range("A1").Value = "Date"

    For Each rng In inpt.Range("A1:A" & lr)
    If rng.Value = "EMP Name" Then
    daterng = rng.Row
        For i = 2 To 8
        nlr = output.Range("A" & Rows.Count).End(3).Row + 1
        output.Cells(nlr, 1).Formula = inpt.Cells(rng.Row, i).Formula
        Next i
    Else
    lc = output.Cells(1, Columns.Count).End(xlToLeft).Column
        If output.Range("A1:" & Cells(1, lc).Address).Find(rng.Value) Is Nothing Then
        output.Cells(1, lc + 1) = rng.Value
        lc = lc + 1
        End If
    nc = output.Range("A1:" & Cells(1, lc).Address).Find(rng.Value).Column
        On Error Resume Next
        For i = 2 To 8
        searchdte = inpt.Cells(daterng, i).Value
        nr = output.Range("A1:A" & nlr).Find(searchdte).Row
        output.Cells(nr, nc).Value = rng.Offset(0, i - 1).Value
        Next i
    End If
    Next rng
form_strng = "='New Data'!$A$2:$A$" & nlr - 1
    With Sheets("Today").Range("A1").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=form_strng
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
 
End Sub

it should be easier from here to pull in your shift information but i hit a snag there since all your information is text - i don't know a way off the top of my head to see how many people are working on a given day using formulas... it should be doable with some more vba, or if you are ok to just include all of your employee names (returning "OFF" or w/e for those employees who are not working you could use a pretty simple hlookup(match())
like:

Formula:

=HLOOKUP(A3,'New Data'!$A$1:$F$23,MATCH(Today!$A$1,'New Data'!$A$1:$A$23,0),FALSE)

as in the attached.

i'm out for the weekend. will try to check back in on Monday - either way if you don't get a hit just reply again with something like "bump no response" or w/e to push this thread back to the top of what's new and someone else should be able to help you out.

actually, just noticed the last row gets overwritten w/ blank values as the "searchdte" returns a blank several times... fixed that and did a couple other clean-up / optimization type lines in this code:

Sub transpose_data()
Dim output As Worksheet
Dim inpt As Worksheet
Dim rng As Range
Dim lr As Long
Dim nlr As Long
Dim daterng As Long
Dim lc As Long
Dim nc As Long
Dim nr As Long
Dim searchdte As Date
Dim form_strng As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

On Error Resume Next
Set output = Sheets("New Data")
    If output Is Nothing Then
    Sheets.Add(, Sheets(Sheets.Count)).Name = "New Data"
Set output = Sheets("New Data")
    End If

Set inpt = Sheets("Data")
lr = inpt.Range("A" & Rows.Count).End(3).Row
output.UsedRange.ClearContents
output.Range("A1").Value = "Date"

    For Each rng In inpt.Range("A1:A" & lr)
    If rng.Value = "EMP Name" Then
    daterng = rng.Row
        For i = 2 To 8
        nlr = output.Range("A" & Rows.Count).End(3).Row + 1
        output.Cells(nlr, 1).Formula = inpt.Cells(rng.Row, i).Formula
        Next i
    Else
    lc = output.Cells(1, Columns.Count).End(xlToLeft).Column
        If output.Range("A1:" & Cells(1, lc).Address).Find(rng.Value) Is Nothing Then
        output.Cells(1, lc + 1) = rng.Value
        lc = lc + 1
        End If
    nc = output.Range("A1:" & Cells(1, lc).Address).Find(rng.Value).Column
        For i = 2 To 8
        If inpt.Cells(daterng, i).Value <> "" Then
        searchdte = inpt.Cells(daterng, i).Value
        nr = output.Range("A1:A" & nlr).Find(searchdte).Row
        output.Cells(nr, nc).Value = rng.Offset(0, i - 1).Value
        End If
        Next i
    End If
    Next rng
form_strng = "='New Data'!$A$2:$A$" & nlr - 1
    With Sheets("Today").Range("A1").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=form_strng
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub

Hi AlyKat,

I'm a little confused - i opened your new sample workbook and ran my code and it looks like it's working to me... i see the blank entries for the early April data in your original file but when i run the code that does not happen, and i'm really struggling to come up with a reason that it would... can't really trouble-shoot since i'm not having any issues.

in answer to your question, the 3 is the same as saying xlUp.

i'm still not having that issue... makes me think there is something unique about those particular date entries on your machine - dates can be kinda fishy in excel sometimes as they are actually stored as an integer # of days past 1/1/1900 (i.e. 4/1/2015 is actually 42095, 4/2 would be 42096), but these integers are typically formatted to look like a date and excel will handle that automatically.

your original data does not hold to this convention and it gave me lots of issues writing the code in the first place (i can't even figure out how to write dates in the format provided... if i edit one of those cells and hit return excel automatically converts them to dates...) so this makes it seem like there must be a setting related to date formatting somewhere which is different on our machines... I'm really not sure what to do with that information except to suggest that you look very closely at the differences between 3/31 and 4/1 in your dataset (are they formatted differently?). also, i changed a line of that code to transfer the values instead of the formula... both work equally well for me but maybe there will be a difference for you:

Sub transpose_data()
Dim output As Worksheet
Dim inpt As Worksheet
Dim rng As Range
Dim lr As Long
Dim nlr As Long
Dim daterng As Long
Dim lc As Long
Dim nc As Long
Dim nr As Long
Dim searchdte As Date
Dim form_strng As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

On Error Resume Next
Set output = Sheets("New Data")
    If output Is Nothing Then
    Sheets.Add(, Sheets(Sheets.Count)).Name = "New Data"
Set output = Sheets("New Data")
    End If

Set inpt = Sheets("Data")
lr = inpt.Range("A" & Rows.Count).End(3).Row
output.UsedRange.ClearContents
output.Range("A1").Value = "Date"

    For Each rng In inpt.Range("A1:A" & lr)
    If rng.Value = "EMP Name" Then
    daterng = rng.Row
        For i = 2 To 8
        nlr = output.Range("A" & Rows.Count).End(3).Row + 1
        output.Cells(nlr, 1).Value = inpt.Cells(rng.Row, i).Value
        Next i
    Else
    lc = output.Cells(1, Columns.Count).End(xlToLeft).Column
        If output.Range("A1:" & Cells(1, lc).Address).Find(rng.Value) Is Nothing Then
        output.Cells(1, lc + 1) = rng.Value
        lc = lc + 1
        End If
    
    nc = output.Range("A1:" & Cells(1, lc).Address).Find(rng.Value).Column
        For i = 2 To 8
        If inpt.Cells(daterng, i).Value <> "" Then
        searchdte = inpt.Cells(daterng, i).Value
        nr = output.Range("A1:A" & nlr).Find(searchdte).Row
        output.Cells(nr, nc).Value = rng.Offset(0, i - 1).Value
        End If
        Next i
    End If
    Next rng
form_strng = "='New Data'!$A$2:$A$" & nlr - 1
    With Sheets("Today").Range("A1").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=form_strng
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub

i have that error for all dates in your original dataset... what about in the "New Data" tab? also, did you try the new code w/ the values fix..? did that do anything to help?

glad i could help. good luck w/ that data - not the most fun source i've ever seen

when stepping through the code, do you know you can hover over variables to see what their value currently is? try stepping through it and hovering over "searchdte" to see what is pulling in there...

Hey Scott,

sorry i missed this post - i suspect it has something to do with our regional settings - for some reason your machine is defaulting to a YY/MM/DD input instead of a MM/DD/YY input. I'm not actually certain which regions follow which convention, i'm pretty sure China and probably most East Asian countries put year first, but I thought Europe / other parts did DD/MM/YY...

rather than speculate further i looked it up. Looks like it might even be a windows setting instead of just an excel setting:
http://excelsemipro.com/2011/06/regi...mats-in-excel/
https://support.office.com/en-ca/art...5-db95123d273e
https://support.office.com/en-nz/art...rs=en-NZ&ad=NZ
http://superuser.com/questions/73037...erns-in-formul


hope this helps!