Home » excel » excel – Using 2 sheets, if cell value matches, bring in Date value from another column

excel – Using 2 sheets, if cell value matches, bring in Date value from another column

Posted by: admin May 14, 2020 Leave a comment

Questions:

Aware of the VLOOKUP option, but would prefer to understand corrections to the below to use a LOOP

I have data in 2 sheets and I’m using a “worker file” to run the macro.

wbTP is the destination and base data set.

wbEVAL is where the macro will be reading from.

Both sheets have an Evaluator ID which acts as the link between the two sheets.

GOAL: Read Evaluator ID starting in Row 2 in wbTP and check each row of the Evaluator ID Column in wbEVAL. If found, return the Complete_Date field found in another column, same row. If not found, do nothing. If found and the field is blank, do nothing.

My code below malfunctions on the OFFSET line that attempts to return the value. I’m still relatively new to VBA so I think my counters are not being used correctly. Any help would be appreciated.

DATA SET EXAMPLE:

wbTP:

CASE ID     CREATE DATE     EVALUATOR ID    COMPLETE DATE
10001       1/2/2019        999             (to be pulled in from wbEVAL) 
10002       1/3/2019        998             (to be pulled in from wbEVAL)
10003       2/1/2019        922             (to be pulled in from wbEVAL)

wbEVAL

CASE NAME   CASE TYPE     EVALUATOR ID   COMPLETE DATE
ABC         ENG            999            2/2/2019
BZG         ENG            998            2/3/2019
BBC         PNG            922            3/1/2019

CODE:

    Sub CompleteDate()


    Dim wbTP As Workbook
    Dim wbEVAL As Workbook

    Dim wsTP As Worksheet
    Dim wsEVAL As Worksheet

    Dim iTP As Long
    Dim iEVAL As Long
    Dim iMACRO As Long


    Set wbTP = Workbooks("TP.csv")
    Set wbEVAL = Workbooks("EvalTable.csv")

    Set wsTP = wbTP.Worksheets.Item("TP")
    Set wsEVAL = wbEVAL.Worksheets.Item("EvalTable")

    lastrowTP = wbTP.Sheets("TP").Range("c" & Rows.Count).End(xlUp).Row
    lastroweval = wbEVAL.Sheets("EvalTable").Range("A" & Rows.Count).End(xlUp).Row

    iMACRO = 1


    For iTP = 2 To lastrowTP
        For iEVAL = 2 To lastroweval
            If wsTP.Cells(iTP, 15) = wsEVAL.Cells(iEVAL, 5) Then

                wsTP.Range("BB").Offset(iTP, 0) = wsEVAL.Cells(iEVAL, "E")

                iMACRO = iMACRO + 1

            End If
        Next iEVAL
    Next iTP

End Sub
How to&Answers:

Why don’t you just use a VLOOKUP formula? You don’t need VBA to do this. You could also just write that VLOOKUP formula with your worker VBA file if you need some kind of automation. Should be easier and a lot faster than 2 loops.

For column COMPLETE DATE in worksheet TP just use

=IFNA(VLOOKUP(C:C,EvalTable!C:D,2,FALSE),"")

or write that formula with VBA (if it needs to be automated):

Worksheet("TP").Range("D2:D100").Formula = "=IFNA(VLOOKUP(C:C,EvalTable!C:D,2,FALSE),"""")"

and adjust your range D2:D100.
So you end up with something like

Option Explicit

Public Sub CompleteDate()
    Dim wsTP As Worksheet
    Set wsTP = ThisWorkbook.Worksheets("TP")

    Dim wsEVAL As Worksheet
    Set wsEVAL = ThisWorkbook.Worksheets("EvalTable")

    Dim LastRowTP As Long
    LastRowTP = wsTP.Cells(wsTP.Rows.Count, "C").End(xlUp).Row

    wsTP.Range("D2:D" & LastRowTP).Formula = "=IFNA(VLOOKUP(C:C," & wsEVAL.Name & "!C:D,2,FALSE),"""")"
End Sub

This would do it by code using 2 loops. But on a bigger amount of data it will be horribly slow. Go with a VLOOKUP formula. Formulas are Excel’s strength.

Option Explicit

Public Sub CompleteDate()
    Dim wsTP As Worksheet
    Set wsTP = ThisWorkbook.Worksheets("TP")

    Dim wsEVAL As Worksheet
    Set wsEVAL = ThisWorkbook.Worksheets("EvalTable")

    Dim LastRowTP As Long
    LastRowTP = wsTP.Cells(wsTP.Rows.Count, "C").End(xlUp).Row

    Dim LastRowEval As Long
    LastRowEval = wsEVAL.Cells(wsEVAL.Rows.Count, "A").End(xlUp).Row

    Dim iTP As Long
    Dim iEVAL As Long

    For iTP = 2 To LastRowTP
        For iEVAL = 2 To LastRowEval
            If wsTP.Cells(iTP, "C") = wsEVAL.Cells(iEVAL, "C") Then
                wsTP.Cells(iTP, "D").Value = wsEVAL.Cells(iEVAL, "D").Value
                Exit For
            End If
        Next iEVAL
    Next iTP
End Sub

Answer:

Ranges, Arrays, Collection, Dictionary

  • You should avoid loops whenever possible.
  • At 10000 unsorted unique records in EvalTable and 65000 records in
    TP, the Dictionary version finished in 1 sec, the Collection version finished a little bit later, VLOOKUP finished under 20s and
    for the range loop version I lost my patience at 5 min and aborted
    it. A loop using arrays version could be considered and maybe an Index/Match version.
  • The first code demonstrates how to utilize the Key in a Collection.
  • With a few changes the same code is converted to a Dictionary version
    (see below), which is even a little faster then the Collection version probably due to the fact that there is no need for string conversion (CStr).

Collection Version

Sub CompleteDate()
    ' Source
    Const cWbS As String = "EvalTable"    ' Workbook Name
    Const cWsS As Variant = "EvalTable"   ' Worksheet Name/Index
    Const cEvS As Variant = "C"           ' Evaluator ID Column Letter/Number
    Const cCdS As Variant = "D"           ' Complete Date Column Letter/Number
    Const cFrS As Long = 2                ' First Row Number
    ' Target
    Const cWbT As String = "TP"   ' Workbook Name
    Const cWsT As Variant = "TP"  ' Worksheet Name/Index
    Const cEvT As Variant = "C"   ' Evaluator ID Column Letter/Number
    Const cCdT As Variant = "D"   ' Complete Date Column Letter/Number
    Const cFrT As Long = 2        ' First Row Number

    Dim Coll As Collection  ' Source Collection
    Dim vntEvS As Variant   ' Source Evaluator ID Array
    Dim vntCdS As Variant   ' Source Complete Date Array
    Dim vntEvT As Variant   ' Target Evaluator ID Array
    Dim vntCdT As Variant   ' Target Complete Date Array

    Dim LurS As Long        ' Source Last Used Row Number
    Dim LurT As Long        ' Target Last Used Row Number
    Dim NorS As Long        ' Source Number of Rows
    Dim NorT As Long        ' Target Number of Rows
    Dim i As Long           ' Source/Target Arrays Row (Element) Counter

    ' In Source Worksheet
    With Workbooks(cWbS).Worksheets(cWsS)
        ' Calculate Last Used Row Number in Evaluator ID Column.
        LurS = .Cells(.Rows.Count, cEvS).End(xlUp).Row
        ' Calculate Evaluator ID Column Range.
        ' Copy Evaluator ID Column Range to Evaluator ID Array.
        vntEvS = .Cells(cFrS, cEvS).Resize(LurS - cFrS + 1)
        ' Copy Complete Date Column Range to Complete Date Array.
        vntCdS = .Cells(cFrS, cCdS).Resize(LurS - cFrS + 1)
    End With

    ' Write number of rows (elements) of Evaluator ID Array to Source
    ' Number of Rows.
    NorS = UBound(vntEvS)
    ' Create a reference to a new collection (Source Collection).
    Set Coll = New Collection
    ' Loop through rows (elements) of Source Arrays (Source Collection).
    For i = 1 To NorS
        ' Write current value of Complete Date Array as current item, and
        ' current value of Evaluator ID Array, converted to string, as current
        ' key to Source Collection.
        Coll.Add vntCdS(i, 1), CStr(vntEvS(i, 1))
    Next

    ' In Target Worksheet
    With Workbooks(cWbT).Worksheets(cWsT)
        ' Calculate Last Used Row Number in Evaluator ID Column.
        LurT = .Cells(.Rows.Count, cEvT).End(xlUp).Row
        ' Calculate Evaluator ID Column Range.
        ' Copy Evaluator ID Column Range to Evaluator ID Array.
        vntEvT = .Cells(cFrT, cEvT).Resize(LurT - cFrT + 1)
    End With

    ' Write number of rows (elements) of Evaluator ID Array to Target
    ' Number of Rows.
    NorT = UBound(vntEvT)
    ' Resize Target Complete Date Array to size of Target Evaluator ID Array.
    ReDim vntCdT(1 To NorT, 1 To 1)
    ' Loop through rows (elements) of Target Arrays.
    For i = 1 To NorT
        ' Use current value of Target Evaluator ID Array, converted to string,
        ' as key to retrieve item from Source Collection to write to current
        ' row (element) of Target Complete Date Array.
        vntCdT(i, 1) = Coll(CStr(vntEvT(i, 1)))
    Next

    ' In Target Worksheet
    With Workbooks(cWbT).Worksheets(cWsT)
        ' Calculate Target Column Range.
        ' Copy Target Complete Date Array to Target Complete Date Column Range.
        .Cells(cFrT, cCdT).Resize(NorT) = vntCdT
    End With

End Sub

Dictionary Version

Sub CompleteDateDict()
    ' Source
    Const cWbS As String = "EvalTable"    ' Workbook Name
    Const cWsS As Variant = "EvalTable"   ' Worksheet Name/Index
    Const cEvS As Variant = "C"           ' Evaluator ID Column Letter/Number
    Const cCdS As Variant = "D"           ' Complete Date Column Letter/Number
    Const cFrS As Long = 2                ' First Row Number
    ' Target
    Const cWbT As String = "TP"   ' Workbook Name
    Const cWsT As Variant = "TP"  ' Worksheet Name/Index
    Const cEvT As Variant = "C"   ' Evaluator ID Column Letter/Number
    Const cCdT As Variant = "D"   ' Complete Date Column Letter/Number
    Const cFrT As Long = 2        ' First Row Number

    Dim dict As Object      ' Source Dictionary
    Dim vntEvS As Variant   ' Source Evaluator ID Array
    Dim vntCdS As Variant   ' Source Complete Date Array
    Dim vntEvT As Variant   ' Target Evaluator ID Array
    Dim vntCdT As Variant   ' Target Complete Date Array

    Dim LurS As Long        ' Source Last Used Row Number
    Dim LurT As Long        ' Target Last Used Row Number
    Dim NorS As Long        ' Source Number of Rows
    Dim NorT As Long        ' Target Number of Rows
    Dim i As Long           ' Source/Target Arrays Row (Element) Counter

    ' In Source Worksheet
    With Workbooks(cWbS).Worksheets(cWsS)
        ' Calculate Last Used Row Number in Evaluator ID Column.
        LurS = .Cells(.Rows.Count, cEvS).End(xlUp).Row
        ' Calculate Evaluator ID Column Range.
        ' Copy Evaluator ID Column Range to Evaluator ID Array.
        vntEvS = .Cells(cFrS, cEvS).Resize(LurS - cFrS + 1)
        ' Copy Complete Date Column Range to Complete Date Array.
        vntCdS = .Cells(cFrS, cCdS).Resize(LurS - cFrS + 1)
    End With

    ' Write number of rows (elements) of Evaluator ID Array to Source
    ' Number of Rows.
    NorS = UBound(vntEvS)
    ' Create a reference to a new collection (Source Collection).
    Set dict = CreateObject("Scripting.Dictionary")
    ' Loop through rows (elements) of Source Arrays (Source Collection).
    For i = 1 To NorS
        ' Write current value of Complete Date Array as current value, and
        ' current value of Evaluator ID Array as current key
        ' to Source Dictionary.
        dict.Add vntEvS(i, 1), vntCdS(i, 1)
    Next

    ' In Target Worksheet
    With Workbooks(cWbT).Worksheets(cWsT)
        ' Calculate Last Used Row Number in Evaluator ID Column.
        LurT = .Cells(.Rows.Count, cEvT).End(xlUp).Row
        ' Calculate Evaluator ID Column Range.
        ' Copy Evaluator ID Column Range to Evaluator ID Array.
        vntEvT = .Cells(cFrT, cEvT).Resize(LurT - cFrT + 1)
    End With

    ' Write number of rows (elements) of Evaluator ID Array to Target
    ' Number of Rows.
    NorT = UBound(vntEvT)
    ' Resize Target Complete Date Array to size of Target Evaluator ID Array.
    ReDim vntCdT(1 To NorT, 1 To 1)
    ' Loop through rows (elements) of Target Arrays.
    For i = 1 To NorT
        ' Use current value of Target Evaluator ID Array as key to retrieve
        ' value from Source Dictionary to write to current row (element)
        ' of Target Complete Date Array.
        vntCdT(i, 1) = dict(vntEvT(i, 1))
    Next

    ' In Target Worksheet
    With Workbooks(cWbT).Worksheets(cWsT)
        ' Calculate Target Column Range.
        ' Copy Target Complete Date Array to Target Complete Date Column Range.
        .Cells(cFrT, cCdT).Resize(NorT) = vntCdT
    End With

End Sub

Answer:

Try the below formula:

=IFNA(VLOOKUP(C2,wbEVAL!$C$2:$D$4,2,FALSE),"")

wbTP:

enter image description here

wbEval:

enter image description here