VBA Macro to find values from two way search

[Belzarak]

Folks,

I've been using a macro for quite some time to copy data based upon a single lookup value (Employee Name). This works great when the source data has fixed columns for the data needed. However, I'm now facing a challenge of needing to look up data not just based on the name, but also on the date that the event happened.

Here is the code I have been using:

Sub ClosedTest()
    
    Dim wsSorc As Worksheet, wsDest As Worksheet
    Dim cell As Range, Found As Range, counter As Long
    
    'Define Source worksheet
    Set wsSorc = Workbooks("Data.xlsx").Sheets("ClosedPivot")
    'Define Destination worksheet
    Set wsDest = Workbooks("Test.xlsm").Sheets("Tuesday")
    
    'Loop for each used cell in column a source
    For Each cell In wsSorc.Range("a2", wsSorc.Range("a" & Rows.Count).End(xlUp))
        If Not IsEmpty(cell) Then
            'Find match for column A source within column A destination
            Set Found = wsDest.Range("A:A").Find(What:=cell.Value, _
                                                 LookIn:=xlValues, _
                                                 LookAt:=xlWhole, _
                                                 SearchOrder:=xlByRows, _
                                                 SearchDirection:=xlNext, _
                                                 MatchCase:=False)
                                                 
            If Not Found Is Nothing Then    'If Match was found...
                'Copy to destination column B (1) matched row from Column C (3) source row
                Found.Offset(, 1).Value = cell.Offset(, 3).Value
                counter = counter + 1
            Else
                'No match was found
            End If
        End If
    Next cell
End Sub

What I need is a way to take this code, or something similar, and add in a second search to find the matching Date. The Date will be in Row 4 on the Data (Source) sheet, and will be in Cell B1 on the Test (Destination) sheet.

The source data will look something like this:

Name 9/4/17 9/5/17 9/6/17 9/7/17
Bob 1 3 2 5
Shelly 2 1 7 3
Ralph 5 2 1 6

I need the macro to copy the value from the intersection of Bob and 9/5/17. I know this should be fairly easy, but my mind just isn't processing the problem correctly right now. Any suggestions would be greatly appreciated.

Thanks,

-Belzarak

 

[Veritan]

Hi Belzarak. Does it absolutely have to be in code? Using an Index-Match formula will accomplish a similar function. I put this formula in cell B2 in the Destination sheet and it can then be copied both down and across (feel free to add an IFERROR to it if you like).

=INDEX(Data!B:B,MATCH($A2,Data!$A:$A,0))

By combining relative, absolute, and mixed cell references, this formula should pull what you need. It works much better than VLOOKUP because you're not restricted to specific ranges and stuck manually telling the formula which column to match against. Also, as a tip, Index-Match can be adjusted to have multiple criteria, though that has to be entered as an array formula. This is a good site for learning how to work with this formula if you like.

 

[Belzarak]

Thanks for the suggestion, Veritan. What you're suggesting is very close to what I have been doing lately. The issue being that the final report needs to have just the values. I was hoping to do it with a vba macro to keep from having to create the report using the formula and then either remove all formula or copy and paste the values to a new report.

 

[Belzarak]

I'm not sure if this will ever be of use to anyone else, but since I found a working solution, I thought I would post it. I'm sure there are better/cleaner/faster ways to get this accomplished, but this was what I was able to cobble together.

Sub ClosedTest()
    
    Dim wsSorc As Worksheet, wsDest As Worksheet
    Dim cell As Range, Found As Range, counter As Long
    Dim strSearch As String
    Dim aCell As Range
    
    'Define Source worksheet
    Set wsSorc = Workbooks("Data.xlsx").Sheets("ClosedPivot")
    'Define Destination worksheet
    Set wsDest = Workbooks("Test.xlsm").Sheets("Tuesday")
    'Specify location of the date
    strSearch = wsDest.Range("B1")
    'search for the date
    Set aCell = wsSorc.Rows(4).Find(What:=strSearch, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    'If the date is found...aCell.Column gives the column number, minus 1 for appropriate offset value.
    If Not aCell Is Nothing Then
    
    'Loop for each used cell in column a source
    For Each cell In wsSorc.Range("a2", wsSorc.Range("a" & Rows.Count).End(xlUp))
        If Not IsEmpty(cell) Then
            'Find match for column A source within column A destination
            Set Found = wsDest.Range("A:A").Find(What:=cell.Value, _
                                                 LookIn:=xlValues, _
                                                 LookAt:=xlWhole, _
                                                 SearchOrder:=xlByRows, _
                                                 SearchDirection:=xlNext, _
                                                 MatchCase:=False)
                                                 
            If Not Found Is Nothing Then    'If Match was found...
                'Copy to destination column B (1) matched row from Column C (3) source row
                Found.Offset(, 1).Value = cell.Offset(, aCell.Column - 1).Value
                counter = counter + 1
            Else
                'No match was found
            End If
        End If
    Next cell
            Else
                'Specified Date was not found in Source worksheet
    End If
    
End Sub

Hopefully this will prove useful to someone else eventually. If not, at least I'll have a record of it when I lose my personal notes on this.

-belzarak