Results 1 to 5 of 5

vba script for % price change over the period

Threaded View

abhi_jain80 vba script for % price change... 06-02-2021, 10:51 AM
AlphaFrog Re: vba script for % price... 06-02-2021, 12:54 PM
abhi_jain80 Re: vba script for % price... 06-04-2021, 05:32 PM
AlphaFrog Re: vba script for % price... 06-05-2021, 07:15 PM
abhi_jain80 Re: vba script for % price... 06-06-2021, 06:20 PM
  1. #1
    Registered User
    Join Date
    08-10-2016
    Location
    Ireland
    MS-Off Ver
    2013
    Posts
    67

    vba script for % price change over the period

    Hi folks,

    I got this vba script from the experts in the thread "New worksheet based on multiple worksheets". This is pulling out the relevant information from the multiple sheets against the unique transactions. Please refer in the sample data attached.

    I wish to add one more in the "output" sheet as % price change over the transactions date. This should come out from the "cost" column in the "transactions" sheet, example: for first transaction "12345678" it should be (4 - 2.14)/2.14 = 87% for the period of 13/01/2020-09/09/2020. Hope I am clear with the need. I have tried to modify the code accordingly but messed it up and couldn't got anything at the end, then thought of reaching out to the experts again. TIA...

    Option Explicit
    Sub DataTest_V3()
        Dim vT, v, vv
        Dim i As Long, d As Object
        Dim t As Double
        
        t = Timer
        vT = Range("Transactions!A1").CurrentRegion.Value2
        Set d = CreateObject("Scripting.Dictionary")
        
        With Worksheets("Output")
            .Cells(1, 1).CurrentRegion.Offset(1).Clear
            
            'Item and Description Transactions
            For i = 2 To UBound(vT)
                d.Item(vT(i, 1)) = vT(i, 2)
            Next i
            .Cells(2, 1).Resize(d.Count) = Application.Transpose(d.keys)
            .Cells(2, 2).Resize(d.Count) = Application.Transpose(d.items)
            d.RemoveAll
            
            'Quantity Transactions
            For i = 2 To UBound(vT)
                d.Item(vT(i, 1)) = d.Item(vT(i, 1)) + vT(i, 4)
            Next i
            .Cells(2, 3).Resize(d.Count) = Application.Transpose(d.items)
            v = d.items
            d.RemoveAll
            
            'First Issue Date Transactions
            For i = 2 To UBound(vT)
                If IsEmpty(d(vT(i, 1))) Then
                    d.Item(vT(i, 1)) = vT(i, 3)
                Else
                    d.Item(vT(i, 1)) = WorksheetFunction.Min(d.Item(vT(i, 1)), vT(i, 3))
                End If
            Next i
            .Cells(2, 4).Resize(d.Count) = Application.Transpose(d.items)
            d.RemoveAll
            
            'Minimum Cost Transactions
            For i = 2 To UBound(vT)
                If IsEmpty(d(vT(i, 1))) Then
                    d.Item(vT(i, 1)) = vT(i, 6)
                Else
                    d.Item(vT(i, 1)) = WorksheetFunction.Min(d.Item(vT(i, 1)), vT(i, 6))
                End If
            Next i
            .Cells(2, 5).Resize(d.Count) = Application.Transpose(d.items)
            d.RemoveAll
            
            'Maximum Cost Transactions
            For i = 2 To UBound(vT)
                If IsEmpty(d(vT(i, 1))) Then
                    d.Item(vT(i, 1)) = vT(i, 6)
                Else
                    d.Item(vT(i, 1)) = WorksheetFunction.Max(d.Item(vT(i, 1)), vT(i, 6))
                End If
            Next i
            .Cells(2, 6).Resize(d.Count) = Application.Transpose(d.items)
            d.RemoveAll
            
            'Total Cost Transactions
            For i = 2 To UBound(vT)
                d.Item(vT(i, 1)) = d.Item(vT(i, 1)) + vT(i, 7)
            Next i
            vv = d.items
            d.RemoveAll
            
            'Average Cost Transactions
            For i = LBound(v) To UBound(v)
                If v(i) = 0 Then
                    d.Item(i + 1) = 0
                Else
                    d.Item(i + 1) = vv(i) / v(i)
                End If
            Next i
            .Cells(2, 7).Resize(d.Count) = Application.Transpose(d.items)
            d.RemoveAll
            
            With .UsedRange
                .Columns("A:B").NumberFormat = "@"
                .Columns("C").NumberFormat = "#,##0"
                .Columns("D").NumberFormat = "d/m/yyyy"
                .Columns("E:G").NumberFormat = "$* #,##0.00"
            End With
            
        End With
        
        MsgBox Timer - t
    End Sub
    Attached Files Attached Files

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Average sales before price change & after price change
    By michts in forum Excel Formulas & Functions
    Replies: 1
    Last Post: 03-04-2021, 10:32 AM
  2. Replies: 3
    Last Post: 10-10-2020, 01:14 AM
  3. [SOLVED] Excel 2013 wants to calculate Sales Price , If cost price exits and wants change SP
    By Bitto in forum Excel Formulas & Functions
    Replies: 3
    Last Post: 05-13-2015, 12:49 PM
  4. Calculate period between multiple dates _VBA script
    By raw_geek in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 05-07-2014, 08:03 AM
  5. [SOLVED] Compare 1 price against multiple prices and change the price according to a formula
    By CharlieAziz in forum Excel Formulas & Functions
    Replies: 9
    Last Post: 10-16-2012, 11:05 AM
  6. Vba Script That Calculates The Payback Period - Excel
    By FSJ in forum Excel Programming / VBA / Macros
    Replies: 7
    Last Post: 06-24-2012, 02:05 AM
  7. Replies: 11
    Last Post: 06-25-2009, 04:47 PM

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1