Check unique parts, copy to another sheet, find cost for each part by date

[Stigmata101]

Hey guys

I have code to complete the first step, identifying unique parts and moving them to the new sheet, thanks to a member of the forum from another post of mine. I am leaving it out in the hopes that I will get a single solution.

Basically what I am trying to do is determine the trend of the cost of parts over a few days.

The first step is to collect all the unique part numbers and copy them to the Trend sheet. Then to find all the values for the previous 5 date entries, these dates are not sequential.

Once all the costs are in the table, I need to evaluate the trend, to determine if there is no change, flat trend, positive trend, or negative trend, increasing or decreasing cost values.

As I said, I have code to do the unique part move and I am using formulas to vlookup the costs and to do the trend analysis. The problem is that there is a large amount of data and the number of formulas kills the workbook.

Sample Workbook:

first half.xlsm

drive.google.com

Appreciate the assistance.
Stig

 

[Akuini]

1. How many rows is your data?

Positive If today value is greater than today - 2 and today - 2 is greater than today - 3, positive trend
2. What if: If today value is greater than today - 2 but today - 2 is less than today - 3
What would be the trend?

 

[Akuini]

Try this:
1. Run Sub getData()
2. I put the result in Sheets("Result"), change to suit:
'adjust sheet name
Sheets("Result").Activate

Sub getData()
'https://www.mrexcel.com/board/threads/check-unique-parts-copy-to-another-sheet-find-cost-for-each-part-by-date.1180939/
Dim i As Long, j As Long, k As Long
Dim va, vb
Dim d As Object

Sheets("ABC Extract").Activate
n = Range("A" & Rows.Count).End(xlUp).Row
va = Range("B2:B" & n)

Set d = CreateObject("scripting.dictionary")
d.CompareMode = vbTextCompare
    For Each x In va
        d(x) = Empty
    Next

va = Range("A2:C" & n)
ReDim vb(1 To UBound(va, 1), 1 To 6)

For Each x In d.keys
    j = j + 1
    k = 6
    For i = UBound(va, 1) To 1 Step -1
        If va(i, 2) = x Then
            If vb(j, 1) = Empty Then vb(j, 1) = va(i, 2)
            vb(j, k) = va(i, 3)
            k = k - 1
        End If
        If k = 1 Then Exit For
    Next
Next

'adjust sheet name
Sheets("Result").Activate
Range("A1").CurrentRegion.Offset(1).ClearContents
Range("A2").Resize(j, 6) = vb
Call getTrend
End Sub

Sub getTrend()
Dim i As Long, n As Long
Dim va, vb

n = Range("A" & Rows.Count).End(xlUp).Row
va = Range("D2:F" & n)
ReDim vb(1 To UBound(va, 1), 1 To 1)
For i = 1 To UBound(va, 1)
    If va(i, 3) > va(i, 2) And va(i, 2) > va(i, 1) Then
        vb(i, 1) = "Positive"
    ElseIf va(i, 3) < va(i, 2) And va(i, 2) < va(i, 1) Then
        vb(i, 1) = "Negative"
    ElseIf va(i, 3) = va(i, 2) And va(i, 2) = va(i, 1) Then
        vb(i, 1) = "Flat"
    End If
Next

Range("g2").Resize(UBound(va, 1), 1) = vb

End Sub

 

[Stigmata101]

Hey Akuini

I tried it but it does not bring back all entries. I have attached the file.

first half.xlsm

drive.google.com

I was wondering if you can break it into 2 parts. The first part is to get all the unique parts numbers and then to populate all the values for the last 5 date entries.

Once all the values are populated, do the trend analysis for the most recent 3 days. Depending on what the data shows me when I run it with the actual data, I might change the analysis to 4 days or 5 days.

Currently, I am sitting on just over 200000 rows of data.

I have also added what the data structure looks like to match the actual columns that I am using.

Appreciate the help.
Stig

 

[Akuini]

I tried it but it does not bring back all entries.

What do you mean?
Your second file has different layout.
Here's what I got when I run the code on the first file:

 

[Akuini]

Here's the file:

Stigmata101 - first half-01.xlsm

Shared with Dropbox

www.dropbox.com

 

[Stigmata101]

Hey Akuini

It works great on the sample Excel you sent me. I did not add it to a module on my workbook, would that be a reason why it did not work for me?

I know that the column structure is slightly different, I was trying to see if it was possible. I am now beginning to believe that anything is possible in Excel if you have the knowledge.

Thanks for the code, it works and I have tested it with my actual column structure and it works. I just had to tweak the column number parts:
vb(j, k) = va(i, 3) became vb(j, k) = va(i, 21)

I will now try it on my full data set. I Will feedback on how that runs.

Stig

 

[Akuini]

Thanks for the code, it works and I have tested it with my actual column structure and it works. I just had to tweak the column number parts:
vb(j, k) = va(i, 3) became vb(j, k) = va(i, 21)

With your large data that will slow the process down.
Try this one:

Sub getData()
'https://www.mrexcel.com/board/threads/check-unique-parts-copy-to-another-sheet-find-cost-for-each-part-by-date.1180939/
Dim i As Long, j As Long, k As Long
Dim va, vb, vc, t
Dim d As Object
t = Timer
Sheets("ABC Extract").Activate
n = Range("A" & Rows.Count).End(xlUp).Row
va = Range("B2:B" & n)

Set d = CreateObject("scripting.dictionary")
d.CompareMode = vbTextCompare
    For Each x In va
        d(x) = Empty
    Next

vc = Range("U2:U" & n)
ReDim vb(1 To UBound(va, 1), 1 To 6)

For Each x In d.keys
    j = j + 1
    k = 6
    For i = UBound(va, 1) To 1 Step -1
        If va(i, 1) = x Then
            If vb(j, 1) = Empty Then vb(j, 1) = va(i, 1)
            vb(j, k) = vc(i, 1)
            k = k - 1
        End If
        If k = 1 Then Exit For
    Next
Next

'adjust sheet name
Sheets("Result").Activate
Range("A1").CurrentRegion.Offset(1).ClearContents
Range("A2").Resize(j, 6) = vb
Call getTrend
Debug.Print Timer - t
End Sub

Sub getTrend()
Dim i As Long, n As Long
Dim va, vb

n = Range("A" & Rows.Count).End(xlUp).Row
va = Range("D2:F" & n)
ReDim vb(1 To UBound(va, 1), 1 To 1)
For i = 1 To UBound(va, 1)
    If va(i, 3) > va(i, 2) And va(i, 2) > va(i, 1) Then
        vb(i, 1) = "Positive"
    ElseIf va(i, 3) < va(i, 2) And va(i, 2) < va(i, 1) Then
        vb(i, 1) = "Negative"
    ElseIf va(i, 3) = va(i, 2) And va(i, 2) = va(i, 1) Then
        vb(i, 1) = "Flat"
    End If
Next

Range("g2").Resize(UBound(va, 1), 1) = vb

End Sub

 

[Stigmata101]

Hey Akuini

I ran both and the last one is about 0.5 seconds quicker ?

This is really going to be a massive help.

Can I ask for another tweak please?

For the trending:
Only evaluate a positive trend if the latest cost is greater than 0.
Only evaluate a negative trend if the latest cost is less than 0.
The flat trend can be both in the greater than or less than cost range.

Stig

Edit:
In the result tab, column A format in text format and all the cost columns in accounting format. If possible.

 

[Akuini]

I'll try it tomorrow , it's almost midnight in my time zone.