Generate a list of columns that contain row matches

**DrKnightArcher** · 09-24-2011, 03:31 AM

I have a data connection that pulls a calendar schedule off the web.

The data is arranged as would be a calendar on the wall, with names under each date corresponding to the Team you are assigned to.

I need a way, array, function, or macro that would take a lookup value, then list, in a single cell, the corresponding dates that a particular person worked (like 1,5,6,7,28,29,30).

The data will change from month to month but the location of the rows that contain the date numbers will be the same (Row 1, 6, 11, 16, 21, 26)

The purpose of this worksheet is that I have to create timesheets that list every day a person was assigned in a month and put that information into a single tiny box.

I have included a worksheet sample, with a data set, a lookup value, and the expected result. I have only begun to do array formulas and lookups and having significant trouble getting anything other than "N/A" values.

Thanks!

**DonkeyOte** · 09-24-2011, 03:57 AM

IMHO you don't want to use formulae here (array or other) as any approach will be inefficient (repetitive) and convoluted. I think a UDF makes a great deal more sense (or sub routine if you wish to repeat for multiple names etc...)

One basic approach:

Function DaysWorked(strName As String, rngDates As Range, rngNames As Range) As String
    Dim lngCnt As Long
    Dim rngArea As Range, rngCol As Range
    For Each rngArea In rngNames.Areas
        lngCnt = lngCnt + 1
        If Application.CountIf(rngArea, strName) Then
            For Each rngCol In rngArea.Columns
                If Application.CountIf(rngCol, strName) Then
                    DaysWorked = DaysWorked & "," & Val(rngDates.Areas(lngCnt).Columns(rngCol.Column - rngNames.Column + 1))
                End If
            Next rngCol
        End If
    Next rngArea
    DaysWorked = Replace(DaysWorked, ",", "", 1, 1)
End Function

The above would be stored in a standard module in VB Editor (in a macro enabled file) and would be invoked from the worksheet along the lines of:

K2:
=DAYSWORKED($J2,($B$1:$H$1,$B$6:$H$6,$B$11:$H$11,$B$16:$H$16,$B$21:$H$21),($B$2:$H$5,$B$7:$H$10,$B$12:$H$15,$B$17:$H$20,$B$22:$H$25))

as you modify J2 so too the output in K2 will adjust accordingly.

The above is just one approach of many you could look to adopt.

**DrKnightArcher** · 09-24-2011, 09:09 AM

Thanks!

This appears to function will one small snag

As you notice on my illustration, there are some cells that have just a number, and others that include a short date code. Thus, the return for persons such as Rachel, Jackie returns a 9 instead of the date.

I may have to find a way to turn those 'dates' into just numbers. Im modifying the query to disable date recognition and will see how this works.

This, however, is a huge leap ahead so thank you kindly for your response.

DrKnightArcher

**DonkeyOte** · 09-25-2011, 01:59 AM

The existing UDF would appear to return consistent values (ie day #)?

If you prefer to return date strings (mm-dd-yyyy) for all values irrespective of whether or not a date is stored in the date header then given the sample dataset you might modify the UDF along the lines of:

Function DaysWorked(strName As String, rngDates As Range, rngNames As Range) As String
    Dim lngCnt As Long
    Dim dtMth As Date
    Dim bDay As Byte
    Dim rngArea As Range, rngCol As Range
    dtMth = Application.Min(rngDates)
    For Each rngArea In rngNames.Areas
        lngCnt = lngCnt + 1
        If Application.CountIf(rngArea, strName) Then
            For Each rngCol In rngArea.Columns
                If Application.CountIf(rngCol, strName) Then
                    bDay = Val(rngDates.Areas(lngCnt).Columns(rngCol.Column - rngNames.Column + 1).Text)
                    DaysWorked = DaysWorked & "," & Format(DateAdd("d", bDay - 1, dtMth), "mm-dd-yyyy")
                End If
            Next rngCol
        End If
    Next rngArea
    DaysWorked = Replace(DaysWorked, ",", "", 1, 1)
End Function

Modify the format of the Date string per requirements.