Odtnhj

***Edit to the question below. I have been playing with it and the problem is in my array resultArray(i). When instead of the line resultArray(i) = Sheets("DeSL_CP").Range("P" & j).Value, I use .Range("M" & i).Value = Sheets("DeSL_CP").Range("P" & j).Value, it works, but takes longer. Can anyone identify why my resultarray(i) is returning all zeros?

***Original post:
I am new to arrays, so I am probably making a stupid mistake. I have two sheets: Summary has a productid in col A and a field that marks the product as unlicensed or licensed in AK. DeSL_CP has multiple lines for each productId (in col B). I need to find the line with activity code (Col K) AA0001 for unlicensed product and return the date for baseline end (col P). Then I need to find the code A0003 for the remaining products and return that lines baseline end. Baseline N should be in col M of the summary sheet.

My code is not throwing errors. It just populates all of column M with 1/0/1900. Help!

Sheets("Summary").Select
Dim lastRow As Long, lastRow1 As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
lastRow1 = Sheets("DeSL_CP").Range("A" & Rows.Count).End(xlUp).Row
lastRow1 = lastRow1 - 1


Dim BaselineEnd As Variant, ActivityCode As Variant, ProductIDDeSL As Variant, Licensed As Variant, ProductIDSumm As Variant
BaselineEnd = ThisWorkbook.Worksheets("DeSL_CP").Range("P2:P" & lastRow1).Value
ActivityCode = ThisWorkbook.Worksheets("DeSL_CP").Range("K2:K" & lastRow1).Value
ProductIDDeSL = ThisWorkbook.Worksheets("DeSL_CP").Range("B2:B" & lastRow1).Value
Licensed = ThisWorkbook.Worksheets("Summary").Range("AK7:AK" & lastRow).Value
ProductIDSumm = ThisWorkbook.Worksheets("Summary").Range("A7:A" & lastRow).Value

Dim resultArray() As Date
ReDim resultArray(7 To lastRow)
Dim i As Long, j As Long

With ThisWorkbook.Worksheets("Summary")
For i = 7 To UBound(ProductIDSumm)
 For j = 2 To UBound(ProductIDDeSL)
 If ProductIDSumm(i, 1) = ProductIDDeSL(j, 1) Then
 If Licensed(i, 1) = "Unlicensed" Then
 If ActivityCode(j, 1) = "AA0001" Then
 resultArray(i) = Sheets("DeSL_CP").Range("P" & j).Value
 Exit For
 End If
 Else
 If ActivityCode(j, 1) = "A0003" Then
 resultArray(i) = Sheets("DeSL_CP").Range("P" & j).Value
 Exit For
 End If
 End If
 End If
 Next j
Next i

.Range("M7").Resize(lastRow - 7 + 1, 1).Value = resultArray
End With

There are times its blank, but many times not. I hid a lot of data to focus on the columns that matterIt is in century month - does that matter?

In the code some issues found like lastRow1 = Sheets("DeSL_CP").Range("A" & Rows.Count).End(xlUp).Row preferred to be based on Col B. also think starting value for the For loops should be 1 instead of 7 and 2 (depending on Option Base). ResultArray could be populated directly from BaselineEnd(j, 1). Finally ResultArray was solved with Range("M7").Resize(UBound(resultArray), 1).Value = resultArray. The Consolidated final code:

 Option Base 1
Sub test()
Sheets("Summary").Select
Dim lastRow As Long, lastRow1 As Long
lastRow = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Row
lastRow1 = Sheets("DeSL_CP").Range("B" & Rows.Count).End(xlUp).Row
lastRow1 = lastRow1 - 1


Dim BaselineEnd As Variant, ActivityCode As Variant, ProductIDDeSL As Variant, Licensed As Variant, ProductIDSumm As Variant
BaselineEnd = ThisWorkbook.Worksheets("DeSL_CP").Range("P2:P" & lastRow1).Value
ActivityCode = ThisWorkbook.Worksheets("DeSL_CP").Range("K2:K" & lastRow1).Value
ProductIDDeSL = ThisWorkbook.Worksheets("DeSL_CP").Range("B2:B" & lastRow1).Value
Licensed = ThisWorkbook.Worksheets("Summary").Range("AK7:AK" & lastRow).Value
ProductIDSumm = ThisWorkbook.Worksheets("Summary").Range("A7:A" & lastRow).Value

Dim resultArray() As Date
ReDim resultArray(lastRow - 7 + 1, 1)
Dim i As Long, j As Long

With ThisWorkbook.Worksheets("Summary")
For i = 1 To UBound(ProductIDSumm)
 For j = 1 To UBound(ProductIDDeSL)
 'If Not Sheets("DeSL_CP").Rows(j).Hidden Then
 If ProductIDSumm(i, 1) = ProductIDDeSL(j, 1) Then
 If Licensed(i, 1) = "Unlicensed" Then
 If ActivityCode(j, 1) = "AA0001" Then
 resultArray(i, 1) = BaselineEnd(j, 1)
 Exit For
 End If
 Else
 If ActivityCode(j, 1) = "A0003" Then
 resultArray(i, 1) = BaselineEnd(j, 1)
 Exit For
 End If
 End If
 End If
 'End If
 Next j
Next i

Range("M7").Resize(UBound(resultArray), 1).Value = resultArray
End With
End Sub

I tried simply with out any array and found working correctly

Sub test2()
Sheets("Summary").Select
Dim lastRow As Long, lastRow1 As Long
Dim i, j As Long, Found As Boolean
lastRow = Range("A" & Rows.Count).End(xlUp).Row
lastRow1 = Sheets("DeSL_CP").Range("B" & Rows.Count).End(xlUp).Row
lastRow1 = lastRow1


Dim BaselineEnd As Variant, ActivityCode As Variant, ProductIDDeSL As Variant, Licensed As Variant, ProductIDSumm As Variant

For i = 7 To lastRow
Found = False
ProductIDSumm = ThisWorkbook.Worksheets("Summary").Cells(i, 1).Value
Licensed = ThisWorkbook.Worksheets("Summary").Cells(i, 37).Value
If ProductIDSumm <> "" Then
 For j = 2 To lastRow1
 ProductIDDeSL = ThisWorkbook.Worksheets("DeSL_CP").Cells(j, 2).Value 'Col B
 ActivityCode = ThisWorkbook.Worksheets("DeSL_CP").Cells(j, 11).Value 'Col K
 BaselineEnd = ThisWorkbook.Worksheets("DeSL_CP").Cells(j, 16).Value ' Col P
 If ProductIDDeSL <> "" Then ' to skip blank rows
 If ProductIDSumm = ProductIDDeSL Then
 If Licensed = "Unlicensed" Then
 If ActivityCode = "AA0001" Then
 Found = True
 Exit For
 End If
 Else
 If ActivityCode = "A0003" Then
 Found = True
 Exit For
 End If
 End If
 End If
 End If
 Next j
ThisWorkbook.Worksheets("Summary").Cells(i, 13).Value = IIf(Found, BaselineEnd, "Not Found")
End If
Next i

Edit: Since You are supposedly in possession of a large data and having processing time problem. merely on curiosity I am adding the find method solution as third option

Sub test3()
Sheets("Summary").Select
Dim lastRow As Long, lastRow1 As Long
Dim i, j As Long, Found As Boolean
lastRow = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Row
lastRow1 = Sheets("DeSL_CP").Range("B" & Rows.Count).End(xlUp).Row
lastRow1 = lastRow1
Dim RngIDsm, RngIDde, Cl, Cl2 As Range
Set RngIDsm = Sheets("Summary").Range("A7:A" & lastRow)
Set RngIDde = Sheets("DeSL_CP").Range("B2:B" & lastRow1)
Dim BaselineEnd As Variant, ActivityCode As Variant, ProductIDDeSL As Variant, Licensed As Variant, ProductIDSumm As Variant

For Each Cl In RngIDsm
Found = False
ProductIDSumm = Cl.Value
Licensed = Cl.Offset(, 36).Value
 With RngIDde
 Set Cl2 = .Find(ProductIDSumm, LookIn:=xlValues)
 If Not Cl2 Is Nothing Then
 firstAddress = Cl2.Address
 Do
 ActivityCode = Cl2.Offset(, 9).Value 'Col K
 If Licensed = "Unlicensed" Then
 If ActivityCode = "AA0001" Then
 BaselineEnd = Cl2.Offset(, 14).Value
 Found = True
 Exit Do
 End If
 Else
 If ActivityCode = "A0003" Then
 BaselineEnd = Cl2.Offset(, 14).Value 
 Found = True
 Exit Do
 End If
 End If
 Set Cl2 = .FindNext(Cl2)
 Loop While Not Cl2 Is Nothing And Cl2.Address <> firstAddress
 End If
 End With
Cl.Offset(, 12).Value = IIf(Found, BaselineEnd, "Not Found")
Next Cl
End Sub

Glad to hear you got it to work...

In regards to your orig question, you would need WorksheetFunction.Transpose(resultArray) for it to paste to a vertical column

Not sure if this would be faster tho