1

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.

Why is resultarray(i) returning all zeros?

Original post:

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 populates all of column M with 1/0/1900.

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 it is blank, but many times not. I hid a lot of data to focus on the columns that matter. It is in century month - does that matter?

DeSL_CP Tab

Summary Tab

7
  • 1
    Could you give us an example of the data it's working with as well - at the moment it looks like Sheets("DeSL_CP").Range("P" & i).Value could be blank, or is the wrong range reference. Commented Nov 12, 2018 at 17:24
  • Examples added! Commented Nov 12, 2018 at 18:04
  • just a note: 1/0/1990 is Excel's way of saying that you gave it a 0 or no value for that spot....which means at those spots in your resultarray it is empty Commented Nov 12, 2018 at 18:53
  • I understand that, but it gives me all 1/0/1990, and they are not all blanks... Commented Nov 12, 2018 at 19:04
  • resultArray(i) will equal the last result of the j FOR/NEXT loop and all earlier values will be overwritten. Is that what you want? Commented Nov 12, 2018 at 20:20

2 Answers 2

1

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
Sign up to request clarification or add additional context in comments.

9 Comments

Hi! Thanks for your comprehensive answer. The first chunk of code is still returning all zeros. I do realize though, that my problem is that my result array needs to have two dimensions. So I am working on that. The second chunk of code does work but it takes over 5 minutes to run. If you take my code with the edit at the top of the question, it is at about 9 seconds - this now works but I am now trying to broaden my understanding of arrays by making the resultarray part still give me the correct data.
Thanks it made my day. Ialso stumbled on resultArray part and finally googoled the solution. Glad 1st chunk of code will work upto your requirement.
@spaindc Since You are supposedly in possession of a large data and having processing time problem, would you favor me by giving feedback about .comparative processing time of the 3 methods. This is merely for curiosity and knowledge.
Hi Ahmed! Method 1 is about 9 seconds, 2 is 5+ minutes, 3 is about 30 seconds. Method 3 did not fully work, it returns all Not Found. For reference, the summary sheet has just over 300 records and the DeSL_CP has just over 40K.
@spaindc, In method 3rd one line was omitted due to typo. Just added now. It is just after If ActivityCode = "A0003" Then. All 3 methods are just again checked with make shift data of about 15 row in summary and about 35 rows in DeSL_CP. All 3 methods are fetching correct result. May please look out for any difference in columns and column offset used by me with your's actual data columns and column offset. Sorry still could not solve your problem.
|
1

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

9 Comments

Checking this now!
is there a line I can add in this code to make 1/0/1900 values be set to blank? Right now I do this separately, after all this code runs, with a for loop. The irony is that it takes longer than the array.
@spaindc what code are you using, there are 3-4 different solution programs posted on this question
so true! I used the 1st solution in Ahmeds answer with the addition of your transpose line.
Do you really need code to do this? I believe you can filter the column for "1/0/1900" then select all with your mouse and press delete... only a couple seconds
|

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.